home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / 476-500 / apd483 / copper-paintv2_1.amos / copper-paintv2_1.amosSourceCode
AMOS Source Code  |  1991-03-05  |  10KB  |  499 lines
  1. '                           Copper-Paint(V2.1)     
  2. '
  3. '                                  By  
  4. '
  5. '                              Storm-coder     
  6. '                           (Cedric Curinier)
  7. '                      Coded with Amos on ??/1992
  8. '                                  
  9. '  
  10. '--------initialisation------- 
  11. '
  12. On Error Proc INIBERROR
  13. Resume Label BLP
  14. Volume(10)
  15. '
  16. B=15 : AFF=1 : V=15 : R=15 : VN=4095 : OVN=0 : DDEP=-1
  17. Dim CO(271)
  18. Screen Open 0,320,270,8,Lowres
  19. Screen Display 0,130,35,,
  20. Curs Off : Flash Off 
  21. Colour 7,$FFF
  22. Colour 5,$0
  23. Limit Mouse 128,35 To 448,305
  24. Paper 2 : Change Mouse 2
  25. Cls 0
  26. Colour 2,$0
  27. Ink 2
  28. Bar 275,0 To 305,30
  29. Ink 5
  30. Bar 280,5 To 300,25
  31. Ink 7
  32. Bar 285,10 To 295,20
  33. Set Rainbow 0,0,271,"","",""
  34. '
  35. '******Prog. principal*******  
  36. '
  37. BLP:
  38. Pen 4
  39. Colour 7,VN
  40. Colour 5,OVN
  41. A$=Inkey$
  42. If A$<>"" Then Goto CHC
  43. If Mouse Key=1
  44.    NPM=NPM+1
  45.    If NPM<2
  46.       Gosub MJ
  47.    End If 
  48.    Goto LPBC
  49. End If 
  50. If Mouse Key=2
  51.    NPM=NPM+1
  52.    If NPM<2
  53.       Gosub MJ
  54.    End If 
  55.    Goto RPBC
  56. End If 
  57. NPM=0
  58. Pen 6
  59. XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse)
  60. If AFF=1 Then Locate 1,30 : Print XM;YM;"   ";
  61. If AFF=1 and DDEP>-1 Then PASS=0 : Print "Y Start gradation:";DDEP;"  "
  62. If DDEP=-1 and PASS=0 Then Paper 0 : Print "                       " : Inc PASS
  63. If AFF=1 and X Text(XM)>0 and Y Text(YM)>0
  64.    Locate 1,31 : Print " X text";X Text(XM);" Y text";Y Text(YM);"  "
  65. End If 
  66. Paper 2
  67. Goto BLP
  68. '
  69. '******* Test Pav� numerique *******   
  70. CHC:
  71. If A$="7" Then R=R+1
  72. If A$="4" Then R=R-1
  73. If A$="8" Then V=V+1
  74. If A$="5" Then V=V-1
  75. If A$="9" Then B=B+1
  76. If A$="6" Then B=B-1
  77. If A$="1" Then R=0
  78. If A$="2" Then V=0
  79. If A$="3" Then B=0
  80. If A$="[" Then R=15
  81. If A$="]" Then V=15
  82. If A$="/" Then B=15
  83. If A$="." Then B=15 : R=15 : V=15
  84. If A$="0" Then B=0 : R=0 : V=0
  85. '
  86. '******** CONTROL Couleurs ******
  87. '
  88. If R>15 Then R=15
  89. If V>15 Then V=15
  90. If B>15 Then B=15
  91. If R<0 Then R=0
  92. If V<0 Then V=0
  93. If B<0 Then B=0
  94. '
  95. '--------Autres fonctions----------- 
  96. '
  97. If A$="s" Then Gosub MJ : Goto PRCH
  98. Goto PPRCH
  99. PRCH:
  100. CFSEL["Save a Copper-Paint picture"]
  101. F$=Param$
  102. If F$="" Then Goto PPRCH
  103. If Exist(F$)
  104.    Bell 4
  105.    CSCREEN
  106.    Print "Picture:" : Print : Centre F$
  107.    Print : Centre "already existe !!!" : Print 
  108.    Input "Overwrite it (y/n)";RR$
  109.    Screen Close 1
  110.    If Upper$(RR$)="Y"
  111.       Goto SPS
  112.    End If 
  113.    Goto PPRCH
  114. End If 
  115. SPS:
  116. Open Out 1,F$
  117. For T=0 To 269
  118.    Print #1,CO(T)
  119. Next 
  120. Close 1
  121. '
  122. PPRCH:
  123. '
  124. If A$="l" Then Goto PRCH1
  125. Goto PPRCH1
  126. PRCH1:
  127. CFSEL["Load a Copper-Paint picture"]
  128. F$=Param$
  129. If F$="" Then Goto PPRCH1
  130. If Exist(F$)=False Then Bell 4 : Goto PPRCH1
  131. Open In 1,F$
  132. For T=0 To 269
  133.    Input #1,CO(T)
  134. Next 
  135. Close 1
  136. For T=0 To 269
  137.    Rain(0,T)=CO(T)
  138.    Rainbow 0,0,35,271
  139. Next 
  140. '
  141. PPRCH1:
  142. If A$="d"
  143.    CSCREEN
  144.    Print 
  145.    Centre Str$(Dfree)+" Bytes free" : Print 
  146.    If Dfree<1900
  147.       Centre "DISC is Full !"
  148.    End If 
  149.    If Dfree>1899
  150.       NICP=Dfree/1900
  151.       Centre "Can save" : Print 
  152.       Print "      a minimum of";NICP;" pictures"
  153.    End If 
  154.    Wait 145 : Screen Close 1
  155. End If 
  156. If A$="n"
  157.    CSCREEN
  158.    Print : Centre F$
  159.    Wait 120 : Screen Close 1
  160. End If 
  161. If A$="a" Then DDEP=-1
  162. If A$="c" Then Gosub PCLS
  163. If A$="q"
  164.    CSCREEN
  165.    Centre "QUIT !" : Print : Print "Are yous sure ?" : Input "(y/n):";RR$
  166.    Screen Close 1
  167.    If Upper$(RR$)="Y"
  168.       CEND
  169.    End If 
  170. End If 
  171. If A$="u" Then Gosub PUNDO
  172. If A$="k"
  173.    CKILL
  174.    If Param$<>""
  175.       CSCREEN
  176.       Centre "Are you sure" : Print 
  177.       Centre "I must kill" : Print 
  178.       Centre Param$+"?" : Print 
  179.       Input "(y/n)";RR$
  180.       Screen Close 1
  181.       If Upper$(RR$)="Y"
  182.          Kill Param$
  183.       End If 
  184.    End If 
  185. End If 
  186. If A$="m" Then CMKDIR : If Param=1 Then Mkdir "df0:Copper-pics"
  187. If A$="e" Then Swap OV,V : Swap OB,B : Swap VN,OVN : Swap OLR,R
  188. YPM=Y Mouse-35
  189. '--------------------FONCTIONS PICK--------------------- 
  190. If A$="p" Then Goto TPP
  191. Goto ZPP
  192. TPP:
  193. TPM=Rain(0,YPM)
  194. TPM$=Hex$(TPM)
  195. If Len(TPM$)=3 Then R=0 : Goto TPP1
  196. If Len(TPM$)=2 Then R=0 : V=0 : Goto TPP2
  197. R$=Left$(TPM$,2)
  198. R$=Right$(R$,1)
  199. A$=R$
  200. CONVDEC[A$]
  201. R=Param
  202. TPP1:
  203. V$=Right$(TPM$,2)
  204. V$=Left$(V$,1)
  205. A$=V$
  206. CONVDEC[A$]
  207. V=Param
  208. TPP2:
  209. B$=Right$(TPM$,1)
  210. A$=B$
  211. CONVDEC[A$]
  212. B=Param
  213. ZPP:
  214. If A$="P" Then OVN=Rain(0,YPM) : Goto TPPP
  215. Goto ZPPP
  216. TPPP:
  217. TPM=Rain(0,YPM)
  218. TPM$=Hex$(TPM)
  219. If Len(TPM$)=3 Then OLR=0 : Goto TPPP1
  220. If Len(TPM$)=2 Then OLR=0 : OV=0 : Goto TPPP2
  221. R$=Left$(TPM$,2)
  222. R$=Right$(R$,1)
  223. A$=R$
  224. CONVDEC[A$]
  225. OLR=Param
  226. TPPP1:
  227. V$=Right$(TPM$,2)
  228. V$=Left$(V$,1)
  229. A$=V$
  230. CONVDEC[A$]
  231. OV=Param
  232. TPPP2:
  233. B$=Right$(TPM$,1)
  234. A$=B$
  235. CONVDEC[A$]
  236. OB=Param
  237. ZPPP:
  238. '
  239. If Scancode=95
  240. CSCREEN
  241. For T=1 To 5
  242. Bell T*2
  243. Read T$
  244. Centre T$
  245. Print 
  246. Wait 50
  247. Next 
  248. Wait 150
  249. Boom 
  250. Screen Close 1
  251. Restore TCRED
  252. TCRED:
  253. Data "For more or updates Write to:"
  254. Data "Cedric Curinier"
  255. Data "Chemin des Ratz"
  256. Data "38330 Saint Nazaire Les Eymes"
  257. Data "France"
  258. End If 
  259. '
  260. If Scancode=89
  261.    AFF=-AFF
  262.    Paper 0
  263.    Ink 0 : Bar 275,0 To 305,30
  264.    If AFF=1
  265.       Ink 2
  266.       Bar 275,0 To 305,30
  267.       Ink 5
  268.       Bar 280,5 To 300,25
  269.       Ink 7
  270.       Bar 285,10 To 295,20
  271.    End If 
  272.    Locate 0,1 : Print Space$(34)
  273.    Locate 0,30 : Print Space$(30)
  274.    Locate 0,31 : Print Space$(30)
  275.    Locate 0,2 : Print Space$(16)
  276.    Paper 2
  277. End If 
  278. '
  279. '/\/\/\/\/\-Affichages en tous Genres-/\/\/\/\/\ 
  280. '
  281. NR=256*R : NV=16*V : NB=B
  282. If AFF=1 Then Locate 0,1 : Print R;"  ";V;"  ";B;"   "
  283. VN=NR+NV+NB
  284. If AFF=1
  285.    Locate 18,1 : Print VN;"   "
  286.    Locate 0,2 : Print " Hex:";Hex$(VN);"       "
  287. End If 
  288. Goto BLP
  289. '
  290. '******************* Sous PROGS. ***************** 
  291. '
  292. '
  293. ' /\/\-Tests souris-/\/\ 
  294. '--------L mouse-------  
  295. LPBC:
  296. C=Y Mouse-35
  297. Rain(0,C)=VN
  298. Rainbow 0,0,35,271
  299. Goto CHC
  300. '---------R mouse------------  
  301. '------D�but de d�grad�------
  302. RPBC:
  303. C=Y Mouse-35
  304. If DDEP=-1
  305.    DDEP=C
  306.    Goto CHC
  307. End If 
  308. '-----Cr�ation du d�grad�----
  309. If C=DDEP Then Goto CHC
  310. DV#=V-OV : DB#=B-OB : DR#=R-OLR : DPOS=C-DDEP
  311. DPV#=OV : DPB#=OB : DPR#=OLR
  312. For VD=DDEP To C Step Sgn(DPOS)
  313.    DPV#=DPV#+DV#/Abs(DPOS) : DPB#=DPB#+DB#/Abs(DPOS) : DPR#=DPR#+DR#/Abs(DPOS)
  314.    DPV2=DPV# : DPB2=DPB# : DPR2=DPR#
  315.    DCOL=256*DPR2+16*DPV2+DPB2
  316.    Rain(0,VD)=DCOL
  317.    Rainbow 0,0,35,271
  318. Next 
  319. DDEP=-1
  320. Goto CHC
  321. '
  322. '   /\/\ Mise a Jour des Co(*) /\/\
  323. MJ:
  324. For C1=0 To 269
  325.    CO(C1)=Rain(0,C1)
  326. Next 
  327. Return 
  328. '
  329. '  /\/\/\ Undo /\/\/\
  330. PUNDO:
  331. For C1=0 To 269
  332.    OCO=Rain(0,C1)
  333.    Rain(0,C1)=CO(C1)
  334.    CO(C1)=OCO
  335. Next 
  336. Rainbow 0,0,35,271
  337. Return 
  338. '
  339. '     /\/\ CLS /\/\
  340. PCLS:
  341. For C1=0 To 269
  342.    CO(C1)=Rain(0,C1)
  343.    Rain(0,C1)=0
  344. Next 
  345. Rainbow 0,0,35,271
  346. ALTN=5
  347. Return 
  348. '
  349. '******************   Procedures ! ! !   ******************
  350. '
  351. '          KIll  
  352. '
  353. Procedure CKILL
  354.    F$=Fsel$("Copper-pics/*.CO",".CO","DELETE a Copper-Paint picture")
  355.    If F$="" Then Goto ZBA
  356.    If Exist(F$)=False Then Bell 4 : F$=""
  357.    ZBA:
  358. End Proc[F$]
  359. '
  360. '         CONVDEC
  361. '
  362. Procedure CONVDEC[A$]
  363.    If A$="A" Then A=10
  364.    If A$="B" Then A=11
  365.    If A$="C" Then A=12
  366.    If A$="D" Then A=13
  367.    If A$="E" Then A=14
  368.    If A$="F" Then A=15
  369.    If A=0 Then A=Val(A$)
  370.    A$=Str$(A)
  371. End Proc[A]
  372. '
  373. '           MKDIR
  374. '
  375. Procedure CMKDIR
  376.    Clear Key 
  377.    Screen Open 1,320,100,4,Lowres
  378.    Colour 1,$0 : Colour 3,$FFF
  379.    Curs Off : Flash Off 
  380.    Paper 1 : Cls : Pen 3
  381.    F$="df0:Copper-pics"
  382.    Print 
  383.    Centre "Making Dir ..."
  384.    Wait 60
  385.    Print : Print 
  386.    If Exist(F$)=False
  387.       TTT=1
  388.       Goto TTC
  389.    End If 
  390.    Bell 1
  391.    Print : Bell 1 : Centre "ERROR" : Wait 40
  392.    Centre "Directory already on disc." : Wait 50 : Bell 18 : Wait 40
  393.    TTC:
  394.    Screen Close 1
  395. End Proc[TTT]
  396. '
  397. '         ERROR
  398. '
  399. Procedure INIBERROR
  400.    Clear Key 
  401.    Screen Open 1,320,150,4,Lowres
  402.    Screen Display 1,135,35,,
  403.    Colour 1,$0
  404.    Colour 3,$F00
  405.    Curs Off : Flash Off 
  406.    Paper 1 : Cls : Pen 3
  407.    Bell 3
  408.    Print : Centre "ERROR ! ! !"
  409.    Wait 10
  410.    Print : Centre "Analysing !" : Wait 30 : Print : Print 
  411.    If Errn=24
  412.       Print "Memory full !"
  413.       Print "I free a few bytes !!!" : Close Workbench : Close Editor 
  414.       DED=1
  415.    End If 
  416.    If Errn=11
  417.       Print "Only";Free;" Bytes free"
  418.       Print "for variables"
  419.       DED=1
  420.    End If 
  421.    If Errn=92
  422.       Print "This disc has:"
  423.       Print "a SPECIAL Protection"
  424.       Print "or"
  425.       Print "It's too much old"
  426.       Print "not a DOS format !"
  427.       DED=1
  428.    End If 
  429.    If Errn=88
  430.       Print "Disc Full" : Print "change it !"
  431.       DED=1
  432.    End If 
  433.    If Errn=84
  434.       Print "Disc Write Protected" : Print "make it write enable."
  435.       DED=1
  436.    End If 
  437.    If Errn=83
  438.       Print "Disc not validated"
  439.       Print "  test it"
  440.       Print "with a VIRUS-killer:"
  441.       Print "LE LAMER-exterminator."
  442.       Print "or use diskdoctor"
  443.       Print "Change it !!!"
  444.       DED=1
  445.    End If 
  446.    If Errn=34 Then Print "Not a Copper-paint picture !" : DED=1
  447.    If Errn=89 or Errn=90
  448.       Print "File seems to"
  449.       Print "be protected !!!"
  450.       DED=1
  451.    End If 
  452.    If Errn=93
  453.       Print "Drive is empty !!!" : Print "Insert disc !"
  454.       DED=1
  455.    End If 
  456.    If Errn=94
  457.       Print "Disc is unreadable !!!"
  458.       Print "I/O Error !!!"
  459.       DED=1
  460.    End If 
  461.    If DED=0
  462.       For T=0 To 800
  463.          Colour 1,T
  464.          Locate 17,5 : Print Hex$(T)
  465.          Inc Z
  466.       Next 
  467.       Print "Error N�";Errn
  468.       Print "Can't understand it ! ! !"
  469.       Input "continue ?  (y/n):";RR$
  470.    End If 
  471.    If Upper$(RR$)="N" Then CEND
  472.    Wait 150
  473.    Screen Close 1
  474.    Resume Label 
  475. End Proc
  476. '
  477. '       Fsel 
  478. '
  479. Procedure CFSEL[A$]
  480.    F$=Fsel$("Copper-pics/*.CO",".CO",A$)
  481. End Proc[F$]
  482. '
  483. '       End
  484. '
  485. Procedure CEND
  486.    Amos To Back 
  487.    For T=1 To 10000
  488.       Poke Rnd(8000),Rnd(255)
  489.    Next 
  490. End Proc
  491. '
  492. '          Sys screen
  493. '    
  494. Procedure CSCREEN
  495.    Screen Open 1,300,50,4,Lowres : Flash Off : Curs Off 
  496.    Colour 1,$0 : Colour 3,$DDD : Cls 1
  497.    Pen 3
  498.    Screen Display 1,150,100,,
  499. End Proc