home *** CD-ROM | disk | FTP | other *** search
/ 17 Bit Software 1: Collection A / 17Bit_Collection_A.iso / files / 282.dms / 282.adf / SourceCode / Rudi-Paint.bas < prev    next >
BASIC Source File  |  1987-02-27  |  7KB  |  251 lines
  1. CLEAR ,35000&,4789
  2. CHDIR ":basicdemos"
  3. LIBRARY"graphics.library"
  4. CHDIR ":rudi-paint"
  5. SCREEN 2,320,256,5,1
  6. WINDOW 3,"Rudi-Paint",,17,2
  7. MENU 1,0,1,"Bild"
  8. MENU 1,1,1,"Löschen"
  9. MENU 1,2,1,"Farbe"
  10. MENU 1,3,1,"Grösse"
  11. MENU 1,4,1,"Laden"
  12. MENU 1,5,1,"Speichern"
  13. MENU 1,6,1,"Beenden"
  14. MENU 1,7,1,"Info"
  15. REM --------------------------------------
  16. MENU 2,0,1,"Modus"
  17. MENU 2,1,2,"  Punkte"
  18. MENU 2,2,1,"  Linie"
  19. MENU 2,3,1,"  Ellipse"
  20. MENU 2,4,1,"  Rechteck"
  21. MENU 2,5,1,"  Fllen"
  22. REM ------------------------------------
  23. MENU 3,0,1,"Pinsel"
  24. MENU 3,1,2,"  Normal"
  25. MENU 3,2,1,"  Fett"
  26. REM ------------------------------------
  27. MENU 4,0,1,"Allgemein"
  28. MENU 4,1,1,"Messer"
  29. MENU 4,2,1,"Kopierer"
  30. MENU 4,3,1,"Spiegel"
  31. MENU 4,4,1,"Text"
  32. REM ------------------------------------
  33. GOTO vmain:
  34. com:
  35. CALL SetDrMd (WINDOW(8),2)
  36. RETURN
  37. norm:
  38. CALL SetDrMd (WINDOW(8),1)
  39. RETURN
  40. SUB gadget(text$,back) STATIC
  41. WINDOW 4,"",(0,0)-(250,50),0,2
  42. PRINT:PRINT text$
  43. LOCATE 5,10:PRINT "JA":LOCATE 5,20:PRINT "NEIN"
  44. LINE (68,28)-(95,43),1,b
  45. LINE (150,28)-(186,43),1,b
  46. gloop:
  47. IF MOUSE (0)=0 THEN gloop
  48. IF MOUSE (1)>67 AND MOUSE(1)<96 AND MOUSE(2)>27 AND MOUSE(2)<44 THEN 
  49. back=1:GOTO gloop1 
  50. END IF
  51. IF MOUSE (1)>149 AND MOUSE(1)<187 AND MOUSE(2)>27 AND MOUSE(2)<44 THEN 
  52. back=0:GOTO gloop1 
  53. END IF
  54. GOTO gloop
  55. gloop1:
  56. WINDOW CLOSE 4 
  57. WINDOW OUTPUT 3
  58. END SUB
  59. REM ----------------------------------------------
  60. vmain:
  61. jumper=1:pinsel=1:kreisf=.88:tiefe=5
  62. main:
  63. x=MENU(0):y=MENU(1):REM  -             -                   -     -
  64. IF x=1 THEN ON y GOSUB bildcut,farbe,pref,laden,speichern,halt,info
  65. REM:                     -     -    -     -   -
  66. IF x=2 THEN ON y GOSUB punkt,linie,kreis,rec,fill
  67. REM                      -     -
  68. IF x=3 THEN ON y GOSUB normal,fett
  69. REM                     -      
  70. IF x=4 THEN ON y GOSUB cut,move,effect,text
  71. IF MOUSE(0)<>0 THEN ON jumper GOSUB punkt,linie,kreis,rec,fill
  72. GOTO main
  73. bildcut:
  74. t$="Sind Sie sicher?":CALL gadget(t$,a):IF a=0 THEN RETURN
  75. CLS:RETURN:REM----------------- 
  76. halt:
  77. a=2:t$="Sind Sie sicher ?":CALL gadget (t$,a):IF a=0 THEN BEEP:RETURN
  78. WINDOW CLOSE 4:SCREEN CLOSE 2:LIBRARY CLOSE:END:REM -----------------
  79. pref: a=2:t$="Das Bild wird gelöscht."+CHR$(13)+"Sind Sie sicher?"
  80. CALL gadget (t$,a):IF a=0 THEN BEEP:RETURN
  81. pref1:start=1:CLS:INPUT "Tiefe";tiefe
  82. IF tiefe<1 OR tiefe>5 THEN BEEP:GOTO pref1  
  83. pref2:a=1:t$="Interlace ein?":CALL gadget(t$,a) 
  84. b=a:FOR t=1 TO 50:a=MOUSE(0):a=MOUSE(1):a=MOUSE(2):NEXT:a=MOUSE(1):a=MOUSE(2)
  85. a=1:t$="Volle Breite?":CALL gadget(t$,a)
  86. FOR t=1 TO 50:c=MOUSE(0):c=MOUSE(1):c=MOUSE(2):NEXT:c=MOUSE(1):c=MOUSE(2)
  87. mode=0:IF b=1 THEN mode=2
  88. mode=mode+a+1
  89. IF (mode=2 AND tiefe>3) OR (mode=3 AND tiefe>3) OR (mode=4 AND tiefe>1) THEN
  90. GOTO pref2
  91. END IF
  92. bride=320:IF a=1 THEN bride=640
  93. high=256:IF b=1 THEN high=512
  94. IF bride=640 AND high=256 THEN kreisf=.44
  95. IF bride=640 AND high=512 THEN kreisf=.88
  96. IF bride=320 AND high=256 THEN kreisf=.88
  97. IF bride=320 AND high=512 THEN kreisf=1.6
  98. WINDOW CLOSE 3:SCREEN CLOSE 2:SCREEN 2,bride,high,tiefe,mode
  99. WINDOW 3,"Rudi-Paint",(0,0)-(bride/2+bride/4,high/4+high/2),17:RETURN
  100. info:WINDOW 4,"Info",(100,100)-(208,150),0,2:REM ------------------
  101. PRINT:PRINT" Rudi Paint!":PRINT"Public Domain":PRINT"Programmed by"
  102. PRINT"Felix Wente":PRINT" Press Space"
  103. WHILE INKEY$<>" ":WEND:WINDOW CLOSE 4:WINDOW OUTPUT 3:RETURN
  104. punkt:REM -------------------------------------
  105. farbe=1:IF x<>0 THEN
  106. FOR t=1 TO 1000:NEXT:s=MOUSE(0)
  107. MENU 2,jumper,1:MENU 2,1,2:jumper=1
  108. RETURN
  109. END IF
  110. PSET(MOUSE(1),MOUSE(2)),farbe
  111. WHILE MOUSE(0)=-1
  112. a=MOUSE(1):b=MOUSE(2)
  113. PSET (a,b),farbe
  114. WEND:RETURN
  115. linie:farbe=1:REM --------------------------------
  116. IF x<>0 THEN
  117. FOR t=1 TO 1000:NEXT:s=MOUSE(0)
  118. MENU 2,jumper,1:MENU 2,2,2:jumper=2
  119. RETURN
  120. END IF
  121. a=MOUSE(1):b=MOUSE(2)
  122. PSET(a,b),farbe
  123. WHILE MOUSE(0)=-1:
  124. c=MOUSE(1):d=MOUSE(2)
  125. GOSUB com:LINE(a,b)-(c,d),1:LINE(a,b)-(c,d),1:GOSUB norm:WEND
  126. c=MOUSE(1):d=MOUSE(2):FOR t=0 TO pinsel-1
  127. LINE (a+t,b)-(c+t,d),farbe
  128. NEXT
  129. FOR t=1 TO 1000:NEXT:s=MOUSE(0)
  130. RETURN
  131. rec:farbe=1:REM --------------------------------
  132. IF x<>0 THEN
  133. FOR t=1 TO 1000:NEXT:s=MOUSE(0) 
  134. MENU 2,jumper,1:MENU 2,4,2:jumper=4
  135. RETURN
  136. END IF
  137. a=MOUSE(1):b=MOUSE(2)
  138. PSET(a,b),farbe
  139. WHILE MOUSE(0)=-1:
  140. c=MOUSE(1):d=MOUSE(2)
  141. GOSUB com:LINE(a,b)-(c,d),1,b:LINE(a,b)-(c,d),1,b:GOSUB norm:WEND
  142. c=MOUSE(1):d=MOUSE(2):FOR t=0 TO pinsel-1
  143. LINE (a+t,b+t)-(c+t,d+t),farbe,b
  144. NEXT
  145. FOR t=1 TO 1000:NEXT:s=MOUSE(0)
  146. RETURN
  147. kreis:farbe=1:REM --------------------------------
  148. IF x<>0 THEN
  149. FOR t=1 TO 1000:NEXT:s=MOUSE(0)
  150. MENU 2,jumper,1:MENU 2,3,2:jumper=3
  151. RETURN
  152. END IF
  153. a=MOUSE(1):b=MOUSE(2)
  154. PSET(a,b),farbe
  155. WHILE MOUSE(0)=-1
  156. c=MOUSE(1):d=MOUSE(2)
  157. GOSUB com:CIRCLE (a,b),SQR(ABS(a-c)^2+ABS(b-d)^2),1,,,kreisf
  158. CIRCLE (a,b),SQR(ABS(a-c)^2+ABS(b-d)^2),1,,,kreisf:GOSUB norm:
  159. WEND
  160. c=MOUSE(1):d=MOUSE(2):FOR t=0 TO pinsel-1 STEP .25
  161. CIRCLE (a,b),SQR(ABS(a-c)^2+ABS(b-d)^2)+t,farbe,,,kreisf
  162. NEXT
  163. FOR t=1 TO 1000:NEXT:s=MOUSE(0)
  164. RETURN
  165. fill:REM -------------------------------------
  166. farbe=1:IF x<>0 THEN
  167. FOR t=1 TO 1000:NEXT:s=MOUSE(0)
  168. MENU 2,jumper,1:MENU 2,5,2:jumper=5
  169. RETURN
  170. END IF
  171. PAINT(MOUSE(1),MOUSE(2)),farbe,1:
  172. FOR t=1 TO 1000:NEXT:s=MOUSE(0):RETURN    
  173. normal:pinsel=1:MENU 3,1,2:MENU 3,2,1:RETURN:REM ---------
  174. fett:pinsel=3:MENU 3,2,2:MENU 3,1,1:RETURN:REM  --------------
  175. cut:
  176. FOR t=1 TO 1000:NEXT:s=MOUSE(0)    
  177. WHILE MOUSE(0)=0:WEND
  178. a=MOUSE(1):b=MOUSE(2)
  179. WHILE MOUSE(0)=-1
  180. c=MOUSE(1):d=MOUSE(2)
  181. GOSUB com:LINE (a,b)-(c,d),1,b:LINE (a,b)-(c,d),1,b:GOSUB norm
  182. WEND
  183. c=MOUSE(1):d=MOUSE(2)
  184. LINE (a,b)-(c,d),0,bf:FOR t=1 TO 1000:NEXT:s=MOUSE(0):RETURN    
  185. move:REM -------------------------------------------
  186. FOR t=1 TO 1000:NEXT:s=MOUSE(0)    
  187. WHILE MOUSE(0)=0:WEND
  188. a=MOUSE(1):b=MOUSE(2)
  189. WHILE MOUSE(0)=-1
  190. c=MOUSE(1):d=MOUSE(2)
  191. GOSUB com:LINE (a,b)-(c,d),1,b:LINE (a,b)-(c,d),1,b:GOSUB norm
  192. WEND
  193. c=MOUSE(1):d=MOUSE(2)
  194. e=INT(ABS(d-b+1)*(ABS(c-a)+16)*tiefe/16)+30
  195. DIM p%(e)
  196. GET (a,b)-(c,d),p%
  197. FOR t=1 TO 1000:NEXT:s=MOUSE(0)
  198. moveloop:
  199. WHILE MOUSE(0)=0
  200. a=MOUSE(1):b=MOUSE(2)
  201. GOSUB com:PUT (a,b),p%:PUT (a,b),p%:GOSUB norm:
  202. WEND
  203. PUT (MOUSE(1),MOUSE(2)),p%,OR
  204. FOR t=1 TO 800:NEXT:s=MOUSE(0)
  205. IF MOUSE(0)=0 THEN moveloop
  206. FOR t=1 TO 1000:NEXT:s=MOUSE(0):ERASE p%:RETURN
  207. text:
  208. FOR t=1 TO 1000:NEXT:s=MOUSE(0)
  209. WHILE MOUSE(0)=0:WEND
  210. x=INT(MOUSE(1)/8):y=INT(MOUSE(2)/8)
  211. t$=""
  212. a=x:b=y
  213. GOSUB com:
  214. tloop1:
  215. c$=INKEY$:IF c$="" THEN LOCATE b,a:PRINT"_":LOCATE b,a:PRINT"_":GOTO tloop1
  216. IF c$=CHR$(13) THEN tloop
  217. IF c$=CHR$(8) THEN 
  218. a=a-1:LOCATE b,a:PRINT b$:LOCATE b,a
  219. IF a=1 THEN BEEP:GOTO tloop1
  220. GOTO tloop1
  221. END IF
  222. t$=t$+c$
  223. LOCATE b,a:a=a+1:IF a>=75 THEN BEEP:GOTO tloop1
  224. PRINT c$;
  225. b$=c$
  226. GOTO tloop1
  227. tloop:
  228. RETURN
  229.  
  230.  
  231.  
  232.  
  233.  
  234.  
  235.  
  236.  
  237.  
  238.  
  239.  
  240.  
  241.  
  242.  
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  
  249.  
  250.  
  251.