home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / COMAL3-1.DMS / in.adf / CITDemos / TinyPaint < prev   
Encoding:
Text File  |  1993-03-30  |  6.8 KB  |  302 lines
  1. // Tiny paint with special 8 color screen
  2.  
  3. USE CITScreen
  4. USE CITWindow
  5. USE CITGadgets
  6. USE CITText
  7. USE CITRequesters
  8. USE CITWorkbench
  9. USE RastPort
  10. USE TempRas
  11. USE IntuitionWindow
  12. USE GraphicsLibrary
  13.  
  14. // Initialization variables
  15. DIM Error OF SHORT
  16. DIM GadTopEdge OF SHORT
  17. DIM GadHeight OF SHORT
  18.  
  19. // Working variables
  20. DIM RP OF POINTER TO RastPort
  21. DIM ButtonDown OF SHORT
  22. DIM CURVE OF SHORT
  23. DIM LINE OF SHORT
  24. DIM CIRCLE OF SHORT
  25. DIM FILL OF SHORT
  26. DIM MODE OF SHORT
  27. DIM MouseX OF SHORT
  28. DIM MouseY OF SHORT
  29. DIM DownX OF SHORT
  30. DIM DownY OF SHORT
  31.  
  32. CURVE:=0
  33. LINE:=1
  34. CIRCLE:=2
  35. FILL:=3
  36. XYratio:=1.9
  37.  
  38. DIM PaintScreen OF CITScreen
  39. PaintScreen.Label("New Paint Screen")
  40. PaintScreen.Depth(3)
  41. CITWorkbench.InsObject(PaintScreen,Error)
  42.  
  43. DIM PaintWd OF CITWindow
  44. PaintWd.Position(0,10)
  45. PaintWd.Size(640,256)     // Height will be maximal
  46. PaintWd.DragBar
  47. PaintWd.DepthGadget
  48. PaintWd.Activate
  49. PaintScreen.InsObject(PaintWd,Error)
  50. IF Error THEN
  51.   STOP "Could'nt open the window"
  52. ENDIF
  53. RP:=PaintWd.Window@.RPort
  54. IF NOT AllocTmpRas(RP@,640,256) THEN
  55.   STOP "No memory"
  56. ENDIF
  57.  
  58. SetAPen(RP,1)
  59.  
  60. GadHeight:=PaintWd.Window@.Height/13
  61.  
  62. DIM Requester OF CITRequester
  63. PaintWd.InsObject(Requester,Error)
  64.  
  65. DIM StopGad OF ButtonGadget
  66. StopGad.Size(80,2*GadHeight)
  67. StopGad.Position(-80,GadTopEdge)
  68. StopGad.Label("Stop",INSIDE)
  69. PaintWd.InsObject(StopGad,Error)
  70. GadTopEdge:+2*GadHeight
  71.  
  72. DIM ClearGad OF ButtonGadget
  73. ClearGad.Size(80,GadHeight)
  74. ClearGad.Position(-80,GadTopEdge)
  75. ClearGad.Label("Clear",INSIDE)
  76. ClearGad.EventHandler(ClearEvent())
  77. PaintWd.InsObject(ClearGad,Error)
  78. GadTopEdge:+GadHeight
  79.  
  80. DIM CurveGad OF ButtonGadget
  81. CurveGad.Size(80,GadHeight)
  82. CurveGad.Position(-80,GadTopEdge)
  83. CurveGad.Label("Curve",INSIDE)
  84. CurveGad.Disable
  85. CurveGad.EventHandler(CurveEvent())
  86. PaintWd.InsObject(CurveGad,Error)
  87. GadTopEdge:+GadHeight
  88.  
  89. DIM LineGad OF ButtonGadget
  90. LineGad.Size(80,GadHeight)
  91. LineGad.Position(-80,GadTopEdge)
  92. LineGad.Label("Line",INSIDE)
  93. LineGad.EventHandler(LineEvent())
  94. PaintWd.InsObject(LineGad,Error)
  95. GadTopEdge:+GadHeight
  96.  
  97. DIM CircleGad OF ButtonGadget
  98. CircleGad.Size(80,GadHeight)
  99. CircleGad.Position(-80,GadTopEdge)
  100. CircleGad.Label("Circle",INSIDE)
  101. CircleGad.EventHandler(CircleEvent())
  102. PaintWd.InsObject(CircleGad,Error)
  103. GadTopEdge:+GadHeight
  104.  
  105. DIM FillGad OF ButtonGadget
  106. FillGad.Size(80,GadHeight)
  107. FillGad.Position(-80,GadTopEdge)
  108. FillGad.Label("Fill",INSIDE)
  109. FillGad.EventHandler(FillEvent())
  110. PaintWd.InsObject(FillGad,Error)
  111. GadTopEdge:+GadHeight
  112.  
  113. DIM Palette OF PaletteGadget
  114. Palette.Size(80,PaintWd.Window@.Height-7*GadHeight-14)
  115. Palette.Position(-80,-(PaintWd.Window@.Height-7*GadHeight-15))
  116. Palette.IndicatorHeight(12)
  117. Palette.Color(1)
  118. Palette.Depth(3)
  119. Palette.EventHandler(PaletteEvent())
  120. PaintWd.InsObject(Palette,Error)
  121.  
  122. PaintWd.SelectEventHandler(Button(,,))
  123. PaintWd.PointerEventHandler(MouseMove(,))
  124. PaintWd.MouseMove(TRUE)
  125.  
  126. DIM TextObj OF CITText
  127. TextObj.BackColor(3)
  128. PaintWd.InsObject(TextObj,Error)
  129.  
  130. IF Error THEN
  131.   STOP "Some of the objects could not be created."
  132. ELSE
  133.   WHILE NOT (StopGad.Pressed AND Requester.Request("Stop program?","Yes|No")) DO WAIT
  134. ENDIF
  135.  
  136. FreeTmpRas
  137. CITWorkbench.RemObject(PaintScreen)
  138.  
  139. // ********* end of main program ***************
  140.  
  141. PROC ClearEvent(dummy OF USHORT)
  142.   IF Requester.Request("Clear all?","Yes|No") THEN
  143.     SetAPen(RP,0)
  144.     RectFill(RP,4,11,555,PaintWd.Window@.Height-3)
  145.     SetAPen(RP,Palette.Value)
  146.   ENDIF
  147. ENDPROC ClearEvent
  148.  
  149. PROC CurveEvent(dummy OF USHORT)
  150.   CurveGad.Disable
  151.   LineGad.Enable
  152.   CircleGad.Enable
  153.   FillGad.Enable
  154.   MODE:=CURVE
  155. ENDPROC CurveEvent
  156.  
  157. PROC LineEvent(dummy OF USHORT)
  158.   CurveGad.Enable
  159.   LineGad.Disable
  160.   CircleGad.Enable
  161.   FillGad.Enable
  162.   MODE:=LINE
  163. ENDPROC LineEvent
  164.  
  165. PROC CircleEvent(dummy OF USHORT)
  166.   CurveGad.Enable
  167.   LineGad.Enable
  168.   CircleGad.Disable
  169.   FillGad.Enable
  170.   MODE:=CIRCLE
  171. ENDPROC CircleEvent
  172.  
  173. PROC FillEvent(dummy OF USHORT)
  174.   CurveGad.Enable
  175.   LineGad.Enable
  176.   CircleGad.Enable
  177.   FillGad.Disable
  178.   MODE:=FILL
  179. ENDPROC FillEvent
  180.  
  181. PROC PaletteEvent(dummy OF USHORT)
  182.   SetAPen(RP,Palette.Value)
  183. ENDPROC PaletteEvent
  184.  
  185. PROC Button(Down OF BYTE,x OF SHORT,y OF SHORT)
  186.   LOCAL dx OF LONG
  187.   LOCAL dy OF LONG
  188.  
  189.   ButtonDown:=Down
  190.   CASE MODE OF
  191.   WHEN LINE
  192.     IF Down THEN
  193.       DownX:=x; DownY:=y
  194.       MouseX:=x; MouseY:=y
  195.       SetDrMd(RP,2)  // DrawMode=COMPLEMENT
  196.     ELSE
  197.       Move(RP,DownX,DownY)
  198.       Draw(RP,MouseX,MouseY)
  199.       PaintWd.Coordinates(MouseX,MouseY)
  200.       SetDrMd(RP,0)  // DrawMode=JAM1
  201.       Move(RP,DownX,DownY)
  202.       Draw(RP,MouseX,MouseY)
  203.     ENDIF
  204.   WHEN CIRCLE
  205.     IF Down THEN
  206.       DownX:=x; DownY:=y
  207.       MouseX:=x; MouseY:=y
  208.       SetDrMd(RP,2)  // DrawMode=COMPLEMENT
  209.       WritePixel(RP,x,y)
  210.     ELIF DownX<>x AND DownY<>y THEN
  211.       dx:=(MouseX-DownX)/2; dy:=(MouseY-DownY)/2
  212.       r:=SQR(dx*dx+dy*dy*XYratio*XYratio)
  213.       DrawEllipse(RP,DownX+dx,DownY+dy,r,r/XYratio)
  214.       PaintWd.Coordinates(MouseX,MouseY)
  215.       SetDrMd(RP,0)  // DrawMode=JAM1
  216.       dx:=(MouseX-DownX)/2; dy:=(MouseY-DownY)/2
  217.       r:=SQR(dx*dx+dy*dy*XYratio*XYratio)
  218.       DrawEllipse(RP,DownX+dx,DownY+dy,r,r/XYratio)
  219.     ENDIF
  220.   WHEN FILL
  221.     IF Down THEN
  222.       dummy:=Flood(RP,1,x,y)
  223.     ENDIF
  224.   OTHERWISE
  225.     MouseX:=x; MouseY:=y
  226.   ENDCASE
  227. ENDPROC Button
  228.  
  229. PROC MouseMove(x OF SHORT,y OF SHORT)
  230.   LOCAL dx OF LONG
  231.   LOCAL dy OF LONG
  232.   LOCAL r OF LONG
  233.  
  234.   TextObj.Print(400,2-11,"x ="+STR$("-###",x))
  235.   TextObj.Print(470,2-11,"y ="+STR$("-###",y))
  236.   IF ButtonDown THEN
  237.     CASE MODE OF
  238.     WHEN CURVE
  239.       Move(RP,MouseX,MouseY)
  240.       Draw(RP,x,y)
  241.       MouseX:=x; MouseY:=y
  242.     WHEN LINE
  243.       Move(RP,DownX,DownY)
  244.       Draw(RP,MouseX,MouseY)
  245.       PaintWd.Coordinates(MouseX,MouseY)
  246.       Move(RP,DownX,DownY)
  247.       Draw(RP,MouseX,MouseY)
  248.     WHEN CIRCLE
  249.       IF DownX<>x AND DownY<>y THEN
  250.         dx:=(MouseX-DownX)/2; dy:=(MouseY-DownY)/2
  251.         r:=SQR(dx*dx+dy*dy*XYratio*XYratio)
  252.         DrawEllipse(RP,DownX+dx,DownY+dy,r,r/XYratio)
  253.         PaintWd.Coordinates(MouseX,MouseY)
  254.         dx:=(MouseX-DownX)/2; dy:=(MouseY-DownY)/2
  255.         r:=SQR(dx*dx+dy*dy*XYratio*XYratio)
  256.         DrawEllipse(RP,DownX+dx,DownY+dy,r,r/XYratio)
  257.       ENDIF
  258.     OTHERWISE
  259.       // No action
  260.     ENDCASE
  261.   ENDIF
  262. ENDPROC MouseMove
  263.  
  264. MODULE TempRas
  265.   USE System
  266.   USE RastPort
  267.   USE GraphicsLibrary
  268.  
  269.   EXPORT AllocTmpRas,FreeTmpRas
  270.  
  271.   DIM TBuf OF POINTER TO UBYTE   // Plane pointer
  272.   DIM TRas OF TmpRas
  273.   DIM TmpRasW OF SHORT, TmpRasH OF SHORT
  274.  
  275.   FUNC AllocTmpRas(REF RP OF RastPort,w OF SHORT,h OF SHORT) OF SHORT
  276.     TBuf:=AllocRaster(w,h)
  277.     IF TBuf=0 THEN
  278.       RETURN FALSE
  279.     ENDIF
  280.     RP.TmpRas:=InitTmpRas(ADR(TRas),TBuf,RASSIZE(w,h))
  281.     TmpRasW:=w; TmpRasH:=h
  282.     RETURN TRUE
  283.   ENDFUNC AllocTmpRas
  284.  
  285.   PROC FreeTmpRas
  286.     IF TBuf THEN
  287.       FreeRaster(TBuf,TmpRasW,TmpRasH)
  288.       TBuf:=0
  289.     ENDIF
  290.   ENDPROC FreeTmpRas
  291.  
  292.   PROC TmpSignal(s OF LONG) SIGNAL
  293.     CASE s OF
  294.     WHEN SIG_CLOSE,SIG_DISCARD,SIG_CLEAR,SIG_END
  295.       FreeTmpRas
  296.     OTHERWISE
  297.       // No action
  298.     ENDCASE
  299.   ENDPROC TmpSignal
  300.  
  301. ENDMODULE TempRas
  302.