Code archives/Algorithms/Pattern Image

This code has been declared by its author to be Public Domain code.

Download source code

Pattern Image by EsseEmmeErre2012
This program let you create a 64x64 tiles 3x3 cubed to draw white dots onto by the mouse.
Pressing the left mouse button let you draw or pressing right mouse button let you leave the drawing.
the 9 tiles are to see the pattern effect!
At end you can leave the program pressign the Esc key.
;-> PatternImage by Stefano Maria Regattin
;i> 1 Dec 2012
;--------------
Const BorderSize=8
Const EmptyShape=0
Const EscKey=27
Const ImageSize=64
Const LeftMouseButton=1
Const RightMouseButton=2
Global WindowSize=BorderSize*2+ImageSize*3
AppTitle("PatternImage public by Stefano Maria Regattin","Press RMB or Esc to leave.")
Graphics(WindowSize,WindowSize,0,2)
For Fading=0 To BorderSize-1
 Color(63+Fading*4,63+Fading*4,63+Fading*4)
 Rect(Fading,Fading,GraphicsWidth()-Fading*2,GraphicsHeight()-Fading*2,EmptyShape)
Next
Color(255,255,255)
EndOfTheProgram=False
Repeat
 KeyPressed=GetKey()
 If KeyPressed=EscKey Then EndOfTheProgram=True
 If MouseDown(RightMouseButton)=True Then EndOfTheProgram=True
 If MouseDown(LeftMouseButton)=True Then
  MouseXPos=MouseX():MouseXPos=MouseY()
  If MouseXPos>=BorderSize And MouseXPos<WindowSize-BorderSize Then
   If MouseYPos>=BorderSize And MouseYPos<WindowSize-BorderSize Then
    PointX=(MouseXPos-BorderSize) Mod ImageSize
    PointY=(MouseYPos-BorderSize) Mod ImageSize
    For ImageCopyY=0 To 2
     For ImageCopyX=0 To 2
      ImageCopyXPos=ImageSize*ImageCopyX
      ImageCopyYPos=ImageSize*ImageCopyY
      Plot(PointX+ImageCopyXPos+BorderSize,PointY+ImageCopyY+BorderSize)
     Next
    Next
   EndIf
  EndIf
 EndIf
Until EndOfTheProgram=True
EndGraphics()
End

Comments

virtlands2013
Well, I certainly tried it.

From my viewpoint left-clicking does nothing.
There could be logic bug somewhere.




gpete2017
this line is the error:
MouseXPos=MouseX():MouseXPos=MouseY()

it should be:
MouseXPos=MouseX():MouseYPos=MouseY()

It works then..but not sure it is useful for anything :)


TomToad2017
There is another bug as well.
Plot(PointX+ImageCopyXPos+BorderSize,PointY+ImageCopyY+BorderSize)
should be changed to
Plot(PointX+ImageCopyXPos+BorderSize,PointY+ImageCopyYPos+BorderSize)


Bobysait2017
well ...

Graphics 800,600,0,2
t=64:i=CreateImage(t,t)
Repeat
If MouseDown(1) WritePixel(MouseX()Mod t,MouseY()Mod t,-1,ImageBuffer(i)) : TileImage i:Flip
Until KeyDown(1)



Code Archives Forum