Section courante

A propos

Section administrative du site

Voici une petite application de programme de dessin Bitmap utilisant le clavier et non la souris pour effectuer des dessins. J'ai écrit se petit programme lorsque j'étais encore très jeune, mais il est toujours intéressant de voir l'évolution qu'on a effectuer...

Le code source GWBASIC de l'application :

  1. 10 ON ERROR GOTO 990
  2. 20 DIM T%(17),TA%(8001),TP%(8001):DEFINT A-Z
  3. 30 XP=159:YP=99:CV=1:MX=159:MY=99:CB=0:BX=XP:BY=YP
  4. 40 A=0:B=0:C=0:D=0:E=0:L=0:R=7:T=0:TX%=159:TY%=99
  5. 50 A$="":B$="Baissé":C$="Crayon ":H$=CHR$(0)+"H":L$="Lever":M$=CHR$(13):P$=CHR$(0)+"P":T$="|":Z$=CHR$(27)
  6. 60 KEY OFF:TROFF
  7. 70 SCREEN 1,1:CLS
  8. 80 GOSUB 1890
  9. 90 PUT(0,0),TA%,PSET
  10. 100 IF XP<0 THEN XP=319 ELSE IF XP>319 THEN XP=0
  11. 110 IF YP<0 THEN YP=199 ELSE IF YP>199 THEN YP=0
  12. 120 FX=XP:FY=YP:BX=XP:BY=YP
  13. 130 GOSUB 1660
  14. 140 IF A$=Z$THEN GOSUB 570
  15. 150 IF A$=CHR$(34)THEN PUT(XP,YP),TP%,PRESET
  16. 160 IF A$="A"THEN 610
  17. 170 IF A$="B"THEN CB=1
  18. 180 IF A$="C"THEN GOSUB 830
  19. 190 IF A$="F"THEN 460
  20. 200 IF A$="G"OR A$=CHR$(8)OR A$="5"OR A$=CHR$(0)+"G"THEN XP=159:YP=99
  21. 210 IF A$="J"THEN GOSUB 920
  22. 220 IF A$="L"THEN CB=0
  23. 230 IF A$="O"OR A$="#"THEN LINE(MX,MY)-(XP,YP),CV,B
  24. 240 IF A$="P"THEN PSET(XP,YP),CV
  25. 250 IF A$="Q"OR A$="7" THEN YP=0:XP=0
  26. 260 IF A$="R"THEN MX=XP:MY=YP
  27. 270 IF A$="S"THEN MX=XP:MY=YP:PSET(XP,YP),CV
  28. 280 IF A$="T"OR A$="_"THEN LINE(MX,MY)-(XP,YP),CV
  29. 290 IF A$="V"OR A$=CHR$(0)+"Q"THEN XP=159:YP=199
  30. 300 IF A$="X"THEN 1180
  31. 310 IF A$="Z"OR A$="3"THEN XP=319:YP=199
  32. 320 IF A$="9"OR A$="/"THEN XP=319:YP=0
  33. 330 IF A$="1"OR A$=","THEN XP=0:YP=199
  34. 340 IF A$="@"OR A$=")"THEN 510
  35. 350 IF A$=";"THEN LINE(MX,MY)-(XP,YP),CV,,&HABAB
  36. 360 IF A$=":"THEN LINE(MX,MY)-(XP,YP),CV,,&HAAAA
  37. 370 IF A$=CHR$(0)+"I"OR A$="^"THEN XP=159:YP=0
  38. 380 IF A$=CHR$(0)+"O"THEN 570
  39. 390 IF A$=CHR$(0)+"R"OR A$="("OR A$="!"THEN 460
  40. 400 IF A$="["THEN XPUT1=XP:YPUT1=YP
  41. 410 IF A$="]"THEN XPUT2=XP:YPUT2=YP:GET(XPUT1,YPUT1)-(XPUT2,YPUT2),TP%
  42. 420 IF A$="\"THEN PUT(XP,YP),TP%,PSET
  43. 430 IF A$="'"THEN PUT(XP,YP),TP%,OR
  44. 440 IF CB THEN LINE(BX,BY)-(XP,YP),CV:BX=XP:BY=YP
  45. 450 GOTO 100
  46. 460 GOSUB 1890:SCREEN 0,0,0,0:WIDTH 80:COLOR 15,1,1:CLS:LOCATE 2,30:PRINT"Liste des dessins":PRINT STRING$(80,"_"):VIEW PRINT 5 TO 23:FILES:VIEW PRINT 1 TO 24
  47. 470 LOCATE 24,1:INPUT"Le nom du dessin est = ",NOM$
  48. 480 IF NOM$=""THEN SCREEN 1,1:GOTO 90
  49. 490 GOSUB 1160:SCREEN 1,1:DEF SEG:BLOAD NOM$,VARPTR(TA%(0)):PUT(0,0),TA%,PSET
  50. 500 GOTO 100
  51. 510 GOSUB 1890:LOCATE 12,1:INPUT"Sous quelle nom nom dois-je le sauver = ",NOM$
  52. 520 IF NOM$=""THEN 90
  53. 530 LOCATE 15,1:PRINT"Je sauvegarde d'une maniere : "M$"(R)eguliere/(C)ompresser":GOSUB 1880:PUT(0,0),TA%,PSET
  54. 550 IF A$=Z$THEN 90 ELSE IF A$="R"OR A$="r"THEN DEF SEG=&HB800:BSAVE NOM$,0,16384:GOTO 90 ELSE IF A$="C"OR A$="c"THEN DEF SEG:BSAVE NOM$,VARPTR(TA%(0)),16004:GOTO 90
  55. 560 GOTO 530
  56. 570 GOSUB 1890:LINE(60,60)-(259,120),0,BF:LINE(64,64)-(255,116),3,B:LOCATE 11,12:PRINT"Est-tu certain que":LOCATE 12,11:PRINT"tu veux quitter (O/N)":LOCATE 14,19:PRINT"? ";
  57. 580 C=(C+1)AND 31:IF(C=0)THEN PRINT"_"+CHR$(29); ELSE IF(C=15)THEN PRINT" "+CHR$(29);
  58. 590 A$=INKEY$:IF A$=""THEN 580
  59. 600 IF(A$="O")OR(A$="o")THEN SCREEN 0,0,0,0:WIDTH 80:COLOR 7,0,0:CLS:KEY ON:END ELSE PUT(0,0),TA%,PSET:RETURN
  60. 610 GOSUB 1890:SCREEN 0,0,0,0:WIDTH 80:COLOR 15,1,1:CLS
  61. 620 LOCATE 1,33:PRINT"Info-Creation"STRING$(80,"_")M$M$
  62. 630 PRINT"A - Aide
  63. 640 PRINT"B - "C$B$
  64. 650 PRINT"C - Change la couleur courant
  65. 660 PRINT"F - Recherche un Fichier
  66. 670 PRINT"G - Positionne le pointeur au centre de l'écran
  67. 680 PRINT"J - Peint une zone de l'écran
  68. 690 PRINT"L - "C$L$
  69. 700 PRINT"O - Trace une boite
  70. 710 PRINT"P - Affiche un Point
  71. 720 PRINT"Q - Positionne le pointeur dans le cote gauche superieur
  72. 730 PRINT"R - Sauvegarde en memoire la position de depart
  73. 740 PRINT"S - Sauvegarde en memoire la position de depart avec un point
  74. 750 PRINT"T - Trace une ligne de la couleur specifier
  75. 760 PRINT"V - Deplacement du pointeur dans le centre inferieur
  76. 770 PRINT"X - Affiche le menu
  77. 780 PRINT"Z - Deplacement du pointeur dans le coin inferieur droit
  78. 790 PRINT"( - Chercher un dessin
  79. 800 PRINT") - Sauver un dessin
  80. 810 LOCATE 25,1:PRINT"Presse une touche pour retouner a l'editeur ...";
  81. 820 IF INKEY$=""THEN 820 ELSE SCREEN 1,1:GOTO 90
  82. 830 GOSUB 1890:LINE(0,99)-(319,199),0,BF:LINE(4,103)-(314,194),3,B
  83. 840 LINE(10,110)-(160,135),CV,BF:LOCATE 16,23:PRINT"Couleur courant"
  84. 850 LINE(10,145)-(160,170),0,BF:LINE(10,145)-(160,170),3,B:LOCATE 20,23:PRINT"Texture courant":IF T$=CHR$(0)THEN PAINT(11,146),0,3 ELSE PAINT(11,146),T$,3
  85. 860 LOCATE 23,3:PRINT C$": ";:IF CB THEN PRINT B$;ELSE PRINT L$;
  86. 870 PRINT"   Esc = Retour"
  87. 880 LOCATE 24,3:PRINT"X ="XP" Y ="YP" C ="CV" T ="ASC(T$);
  88. 890 GOSUB 1880
  89. 900 IF A$="C"OR A$="c"THEN CV=(CV+1)AND 3 ELSE IF A$="T"OR A$="t"THEN T$=CHR$((ASC(T$)+1)AND 255)ELSE IF A$=Z$THEN PUT(0,0),TA%,PSET:RETURN ELSE 890
  90. 910 GOTO 840
  91. 920 GOSUB 1890:LINE(10,10)-(160,35),3,B:LOCATE 4,23:PRINT"Texture de peinte":LINE(10,45)-(160,70),CV,BF:LOCATE 8,23:PRINT"Couleur d'arret":LOCATE 12,1:PRINT"Est-tu certain que tu veux peinturer (O/N)":LOCATE 14,19:PRINT"? ";
  92. 930 LINE(11,11)-(159,34),0,BF:IF T$=CHR$(0)THEN PAINT(11,11),0,3 ELSE PAINT(11,11),T$,3
  93. 940 C=(C+1)AND 31:IF(C=0)THEN PRINT"_"+CHR$(29); ELSE IF(C=15)THEN PRINT" "+CHR$(29);
  94. 950 A$=INKEY$:IF A$=""THEN 940
  95. 960 IF(A$="O")OR(A$="o")THEN A$="":GOTO 970 ELSE PUT(0,0),TA%,PSET:RETURN
  96. 970 PUT(0,0),TA%,PSET:IF T$=CHR$(0)THEN PAINT(XP,YP),0,CV ELSE PAINT(XP,YP),T$,CV
  97. 980 RETURN
  98. 990 SCREEN 0,0,0,0:WIDTH 80:COLOR 15,1,1:CLS:KEY ON
  99. 1000 IF(ERR=7)THEN PRINT"Erreur de memoire"M$"Ce programme nessecite les 65536 octets de memoire disponible":RESUME 1060
  100. 1010 IF(ERR=53)THEN 1070
  101. 1020 IF(ERR=5)AND(ERL=420)THEN 100
  102. 1030 PRINT"Erreur numero :"ERR
  103. 1040 PRINT"A la ligne    :"ERL,M$STRING$(25,"-")
  104. 1050 RESUME 1060
  105. 1060 END
  106. 1070 LOCATE 1,30:PRINT"Fichier incorrect"STRING$(80,"_")
  107. 1080 LOCATE 8,8:PRINT"1 - Aborde"
  108. 1090 LOCATE 10,8:PRINT"2 - Retrait"
  109. 1100 LOCATE 12,8:PRINT"3 - Ignore"
  110. 1110 LOCATE 16,5,1:PRINT"Votre choix ?";
  111. 1120 A$=INKEY$:IF A$=""THEN 1120
  112. 1130 IF A$=Z$THEN 90
  113. 1140 IF A$="1"THEN SCREEN 1,1:RESUME 90 ELSE IF A$="2"THEN SCREEN 1,1:PUT(0,0),TA%,PSET:RESUME NEXT ELSE IF A$="3"THEN RESUME
  114. 1150 GOTO 1120
  115. 1160 'OPEN"O",#1,NOM$
  116. 1170 L=16384:RETURN
  117. 1180 GOSUB 1890:LINE(75,35)-(245,155),0,BF:LINE(80,40)-(240,150),1,B
  118. 1190 LOCATE 7,18:PRINT"Menu
  119. 1200 LOCATE 9,12:PRINT"Boite
  120. 1210 LOCATE 10,12:PRINT"Couleur/Texture
  121. 1220 LOCATE 11,12:PRINT"Cercle
  122. 1230 LOCATE 12,12:PRINT C$;:IF CB THEN PRINT B$ELSE PRINT L$
  123. 1240 LOCATE 13,12:PRINT"Peint
  124. 1250 LOCATE 14,12:PRINT"Point
  125. 1260 LOCATE 15,12:PRINT"Ligne
  126. 1270 LOCATE 16,12:PRINT"Chercher
  127. 1280 LOCATE 17,12:PRINT"Sauver
  128. 1290 LOCATE 18,12:PRINT"Quitter
  129. 1300 GET(75,35)-(245,155),TP%:PUT(75,35),TP%,PRESET:M=0
  130. 1310 N=64+M*8:GET(85,N)-(235,N+7),TP%
  131. 1320 PUT(85,N),TP%,PRESET
  132. 1330 GOSUB 1880
  133. 1340 PUT(85,N),TP%,PSET
  134. 1350 IF A$=H$THEN M=M-1 ELSE IF A$=P$THEN M=M+1
  135. 1360 IF(M>9)THEN M=0 ELSE IF(M<0)THEN M=9
  136. 1370 IF A$=Z$THEN 90 ELSE IF M$=A$THEN PUT(0,0),TA%,PSET:ON M+1 GOTO 1390,1430,1440,1480,1520,1550,1580,460,510,1620
  137. 1380 GOTO 1310
  138. 1390 S=0
  139. 1400 GOSUB 1640
  140. 1410 IF A$=M$AND S THEN LINE(MX,MY)-(XP,YP),CV,B:S=0 ELSE IF A$=M$THEN MX=XP:MY=YP:S=1 ELSE IF A$="C"THEN GOSUB 830 ELSE IF A$=Z$THEN 1180
  141. 1420 GOTO 1400
  142. 1430 GOSUB 830:GOTO 1180
  143. 1440 C=0
  144. 1450 GOSUB 1640
  145. 1460 IF A$=M$AND C THEN CIRCLE(MX,MY),ABS(MX-XP)+ABS(MY-YP),CV,,,20/32:C=0 ELSE IF A$=M$THEN MX=XP:MY=YP:C=1 ELSE IF A$="C"THEN GOSUB 830 ELSE IF A$=Z$THEN 1180
  146. 1470 GOTO 1450
  147. 1480 C=0:BX=159:BY=99
  148. 1490 GOSUB 1640:LINE(BX,BY)-(XP,YP),CV:BX=XP:BY=YP
  149. 1500 IF A$="C"THEN GOSUB 830 ELSE IF A$=Z$THEN 1180
  150. 1510 GOTO 1490
  151. 1520 GOSUB 1640
  152. 1530 IF M$=A$THEN GOSUB 920 ELSE IF A$="C"THEN GOSUB 830 ELSE IF A$=Z$THEN 1180
  153. 1540 GOTO 1520
  154. 1550 GOSUB 1640
  155. 1560 IF M$=A$THEN PSET(XP,YP),CV ELSE IF A$="C"THEN GOSUB 830 ELSE IF A$=Z$THEN 1180
  156. 1570 GOTO 1550
  157. 1580 C=0
  158. 1590 GOSUB 1640
  159. 1600 IF A$=M$AND C THEN LINE(MX,MY)-(XP,YP),CV:C=0 ELSE IF M$=A$THEN MX=XP:MY=YP:C=1:ELSE IF A$="C"THEN GOSUB 830 ELSE IF A$=Z$THEN 1180
  160. 1610 GOTO 1590
  161. 1620 GOSUB 570:GOTO 1180
  162. 1630 'Sous-Programme
  163. 1640 IF(XP<0)THEN XP=319 ELSE IF(XP>319)THEN XP=0
  164. 1650 IF(YP<0)THEN YP=199 ELSE IF(YP>199)THEN YP=0
  165. 1660 TX%=XP-4:IF(TX%<0)THEN TX%=0
  166. 1670 IF(TX%>311)THEN TX%=311
  167. 1680 TY%=YP-3:IF(TY%<0)THEN TY%=0
  168. 1690 IF(TY%>193)THEN TY%=193
  169. 1700 GET(TX%,TY%)-(TX%+8,TY%+6),T%
  170. 1710 DRAW"BM"+STR$(XP)+","+STR$(YP)+"C=IC;ND2NL2NR2U2":IC=(IC+1)AND 3
  171. 1720 A$=INKEY$:IF A$=""THEN 1710
  172. 1730 TX%=XP-4:IF(TX%<0)THEN TX%=0
  173. 1740 IF(TX%>311)THEN TX%=311
  174. 1750 TY%=YP-3:IF TY%<0 THEN TY%=0
  175. 1760 IF(TY%>193)THEN TY%=193
  176. 1770 PUT(TX%,TY%),T%,PSET
  177. 1780 IF A$="2"THEN YP=YP+10
  178. 1790 IF A$="4"THEN XP=XP-10
  179. 1800 IF A$="6"THEN XP=XP+10
  180. 1810 IF A$="8"THEN YP=YP-10
  181. 1820 IF A$=H$THEN YP=YP-1
  182. 1830 IF A$=CHR$(0)+"K"THEN XP=XP-1
  183. 1840 IF A$=CHR$(0)+"M"THEN XP=XP+1
  184. 1850 IF A$=P$THEN YP=YP+1
  185. 1860 IF(A$>"`")AND(A$<"{")THEN A$=CHR$(ASC(A$)-32)
  186. 1870 RETURN
  187. 1880 A$=INKEY$:IF A$=""THEN 1880 ELSE RETURN
  188. 1890 GET(0,0)-(319,199),TA%:RETURN

Dernière mise à jour : Samedi, le 24 janvier 2015