home *** CD-ROM | disk | FTP | other *** search
/ Crawly Crypt Collection 1 / crawlyvol1.bin / utility / misc / casio_st / listings / farbcode.cas < prev   
Text File  |  1992-08-01  |  2KB  |  52 lines
  1. 10 'Farbcode (c) uk 01.08.92
  2. 20 CLS:CLEAR:LOCATE 0,0:PRINT"[K]ohleschicht (4 Ringe)";
  3. 30 LOCATE 0,1:PRINT"[M]etallfilm (5 Ringe)";:R=1:Z$=INPUT$(1,@)
  4. 40 IF Z$="K" THEN R=4
  5. 50 IF Z$="M" THEN R=5
  6. 60 IF R=1 THEN 20
  7. 70 CLS:LOCATE0,0:PRINT CHR$(230);"Schw Brau Rot  Oran Gelb Gr";CHR$(255);"n   Blau Lila Grau Wei";CHR$(137);" Gold Silb";
  8. 80 DEFCHR$(255)="5C0202045E":NULL$="000000000"
  9. 90 Z=0:S=0:V=0:I=1
  10. 100 DIM R(R)
  11. 110 T=ASC(INPUT$(1,@))
  12. 120 V=0
  13. 130 IF T=28THEN S=S+5:V=1
  14. 140 IF S>26THEN S=0
  15. 150 IF T=29THEN S=S-5:V=1
  16. 160 IF S<0THEN S=25
  17. 170 IF T=30THEN Z=Z+1:V=1
  18. 180 IF Z>1THEN Z=0
  19. 190 IF T=31THEN Z=Z-1:V=1
  20. 200 IF Z<0THEN Z=1
  21. 210 IF T=13 THEN R(I)=S\5+Z*6:I=I+1
  22. 220 IF V=1 THEN LOCATE0,0:PRINT " Schw Brau Rot  Oran Gelb Gr";CHR$(255);"n   Blau Lila Grau Wei";CHR$(137);" Gold Silb";
  23. 230 LOCATE S,Z:PRINT CHR$(230);
  24. 240 IF I=R+1 THEN 260
  25. 250 GOTO 110
  26. 260 IF R=4 THEN GOSUB 300
  27. 270 IF R=5 THEN GOSUB 370
  28. 280 GOSUB 440
  29. 290 GOTO 20
  30. 300 IF R(3)=10 THEN AUS$=RIGHT$(STR$(R(1)),1)+"."+RIGHT$(STR$(R(2)),1)
  31. 310 IF R(3)=11 THEN AUS$="."+RIGHT$(STR$(R(1)),1)+RIGHT$(STR$(R(2)),1)
  32. 320 IF R(3)<10 THEN AUS$=RIGHT$(STR$(R(1)),1)+RIGHT$(STR$(R(2)),1)+MID$(NULL$,1,R(3))
  33. 330 IF R(4)=2 THEN L=2:RETURN
  34. 340 IF R(4)=10 THEN L=5:RETURN
  35. 350 IF R(4)=11 THEN L=10 ELSE L=20
  36. 360 RETURN
  37. 370 IF R(4)=10 THEN AUS$=RIGHT$(STR$(R(1)),1)+RIGHT$(STR$(R(2)),1)"."+RIGHT$(STR$(R(3)),1)
  38. 380 IF R(4)=11 THEN AUS$="."+RIGHT$(STR$(R(1)),1)+RIGHT$(STR$(R(2)),1)+RIGHT$(STR$(R(3)),1)
  39. 390 IF R(4)<10 THEN AUS$=RIGHT$(STR$(R(1)),1)+RIGHT$(STR$(R(2)),1)+RIGHT$(STR$(R(3)),1)+MID$(NULL$,1,R(4))
  40. 400 IF R(5)=1 THEN L=1:RETURN
  41. 410 IF R(5)=2 THEN L=2:RETURN
  42. 420 IF R(5)=5 THEN L=0.5 ELSE L=20
  43. 430 RETURN
  44. 440 AUS=VAL(AUS$)
  45. 450 AUSK=AUS/1000
  46. 460 AUSM=AUS/1000000
  47. 470 CLS
  48. 480 IF FIX(AUSK)>0 AND FIX(AUSM)=0 THEN PRINT AUSK;" K";CHR$(133);" +/-";L;"%"
  49. 490 IF FIX(AUSM)>0 THEN PRINT AUSM;" M";CHR$(133);" +/-";L;"%"
  50. 500 IF AUS<1000 THEN PRINT AUS;CHR$(133);" +/-";L;"%"
  51. 510 RETURN
  52.