home *** CD-ROM | disk | FTP | other *** search
/ AMIGA PD 1 / AMIGA-PD-1.iso / Programme_zum_Heft / Programmieren / Kurztests / ACE / Prgs / games / cardmaster.lha / cardmaster.b < prev    next >
Text File  |  1994-12-11  |  8KB  |  358 lines
  1. rem  ***  CardMaster  ***
  2.  
  3. OPTION O+
  4.  
  5. dim set$(7)
  6. dim rarity$(13)
  7. dim clor$(8)
  8. dim type$(7)
  9.  
  10. dim freq(13)
  11. dim unifreq(13)
  12. dim colcount(6,8)
  13. dim unicount(6,8)
  14. dim setcount(6)
  15. dim unisetct(6)
  16.  
  17. CONST NULL = 0&
  18.  
  19. window 1,"CardMASTER 1.2© by Rich Allen",(0,0)-(360,181),22
  20.  
  21. FONT "topaz",8
  22.  
  23. struct card
  24.   shortint number
  25.   shortint set
  26.   shortint rarity
  27.   shortint ccolor
  28.   shortint ctype
  29.   string   cname
  30.   address  nextc
  31.   address  prevc
  32. end struct
  33.  
  34. declare struct card *head,*new.card,*curr,*temp
  35.  
  36. sub make.card&
  37.   make.card& = Alloc(sizeof(card),2)
  38. end sub
  39.  
  40. head = make.card&
  41. if head = NULL then
  42.   print "Head card can't be allocated!"
  43.   stop
  44. end if
  45.  
  46. head->number = NULL
  47. head->set    = NULL
  48. head->rarity = NULL
  49. head->ccolor = NULL
  50. head->ctype  = NULL
  51. head->cname  = ""
  52. head->nextc  = NULL
  53. head->prevc  = NULL
  54. curr = head
  55. temp = head
  56.  
  57. for loop = 1 to 7
  58.   read set$(loop)
  59. next
  60. for loop = 1 to 13
  61.   read rarity$(loop)
  62. next
  63. for loop = 1 to 8
  64.   read clor$(loop)
  65. next
  66. for loop = 1 to 7
  67.   read type$(loop)
  68. next
  69.  
  70. data Revised,"The Dark",Antiquities,"Arabian Nights",Legends,Unlimited,"Fallen Empires"
  71. data Land,"Common",Uncommon,Rare,Common1,Common2,Common3,Common4,Common5
  72. data Uncommon1,Uncommon2,Uncommon3,Uncommon4
  73. data Land,Artifact,Black,Blue,Green,Red,White,Gold
  74. data Enchantment,Instant,Interrupt,Sorcery,Summon,Artifact,"Artifact Creature"
  75.  
  76. cls
  77.  
  78. gadget  1,ON ,"QUIT",(80,104)-(130,128),BUTTON
  79. gadget  2,OFF,"ADD CARD",(3,96)-(75,115),BUTTON
  80. gadget  3,OFF,"SUB CARD",(3,118)-(75,137),BUTTON
  81. gadget  4,OFF,"NEXT CARD",(135,96)-(225,115),BUTTON
  82. gadget  5,OFF,"PREV CARD",(135,118)-(225,137),BUTTON
  83. gadget  6,ON ,"LOAD DATABASE",(232,30)-(349,49),BUTTON
  84. gadget  7,OFF,"SAVE DATABASE",(232,52)-(349,71),BUTTON
  85. gadget  8,OFF,"COUNT TO PRT:",(232,74)-(349,93),BUTTON
  86. gadget  9,OFF,"COUNT TO DISK",(232,96)-(349,115),BUTTON
  87. gadget 10,OFF,"LIST TO PRT:",(232,118)-(349,137),BUTTON
  88. gadget 11,OFF,"LIST TO DISK",(232,140)-(349,159),BUTTON
  89.  
  90. WHILE -1
  91.   gadget wait 0
  92.   gosub button_pushed
  93.   gosub display
  94. WEND
  95.  
  96. button_pushed:
  97.   gad = gadget(1)
  98.   if gad =  1 then if MsgBox("Are you sure?","Yes","Nope") then quit
  99.   if gad =  2 and curr->number < 256 then curr->number = curr->number + 1
  100.   if gad =  3 and curr->number > 0   then curr->number = curr->number - 1
  101.   if gad =  4 then curr = curr->nextc
  102.   if gad =  5 then curr = curr->prevc
  103.   if gad =  6 then gosub loaddb
  104.   if gad =  7 then gosub savedb
  105.   if gad =  8 then
  106.                 file$ = "PRT:"
  107.                 gosub count
  108.               end if
  109.   if gad =  9 then
  110.                 file$ = filebox$("Save COUNT to")
  111.                 if file$ <> "" then gosub count
  112.               end if
  113.   if gad = 10 then
  114.                 file$ = "PRT:"
  115.                 gosub genlist
  116.               end if
  117.   if gad = 11 then
  118.                 file$ = filebox$("Save LIST to")
  119.                 if file$ <> "" then gosub genlist
  120.               end if
  121.   if gad = 20 then gosub search
  122. return
  123.  
  124. display:
  125.   locate 2
  126.   print " Card  : ";curr->cname;space$(30)
  127.   print
  128.   print " Color : ";clor$(curr->ccolor);"     "
  129.   print " Rarity: ";rarity$(curr->rarity);"     "
  130.   print " Type  : ";type$(curr->ctype);space$(18-len(type$(curr->ctype)))
  131.   print " Set   : ";set$(curr->set);"       "
  132.   print
  133.   print " # of cards: ";curr->number;"   "
  134. return
  135.  
  136. loaddb:
  137.   file$ = filebox$("Load database")
  138.   if file$ <> "" then
  139.     window 2,,(50,100)-(300,150),0
  140.     FONT "topaz",8
  141.     cls
  142.     locate 2
  143.     print " Loading card data..."
  144.     
  145.     open "I",1,file$
  146.     input #1,numcards
  147.  
  148.     For loop = 1 to numcards
  149.       input #1,code$,card$
  150.   
  151.       locate 2,22
  152.       print loop
  153.  
  154.       new.card = make.card&
  155.       if new.card = NULL then
  156.         temp& = MsgBox("Out of memory!","OK")
  157.         close 1
  158.         window close 2
  159.         goto quit
  160.       end if
  161.  
  162.       new.card->number = val("&H"+left$(code$,2))
  163.       new.card->ccolor = val(mid$(code$,3,1))
  164.       new.card->ctype  = val(mid$(code$,4,1))
  165.       new.card->set    = val(mid$(code$,5,1))
  166.       new.card->rarity = val("&H"+right$(code$,1))
  167.       new.card->cname  = card$
  168.       new.card->nextc  = NULL
  169.       curr->nextc = new.card
  170.       curr->prevc = temp
  171.       temp = curr
  172.       curr = curr->nextc
  173.  
  174.     Next
  175.  
  176.     curr->prevc = temp
  177.     temp = curr
  178.     curr = head->nextc
  179.     curr->prevc = temp
  180.     temp->nextc = curr
  181.  
  182.     close 1
  183.     window close 2
  184.   end if
  185.   gadget  2,ON
  186.   gadget  3,ON
  187.   gadget  4,ON
  188.   gadget  5,ON
  189.   gadget  6,OFF
  190.   gadget  7,ON
  191.   gadget  8,ON
  192.   gadget  9,ON
  193.   gadget 10,ON
  194.   gadget 11,ON
  195.   gadget 20,ON,"Search for a card name",(8,144)-(230,161),STRING
  196. return
  197.  
  198.  
  199. savedb:
  200.   file$ = filebox$("Save database")
  201.   if file$ <> "" then
  202.     window 2,,(50,100)-(300,150),0
  203.     FONT "topaz",8
  204.     cls
  205.     locate 2
  206.     print " Saving card data..."
  207.     open "O",1,file$
  208.     write #1,numcards
  209.     temp = curr
  210.     curr = head->nextc
  211.     for loop = 1 to numcards
  212.       code$ = hex$(curr->number) + hex$(curr->ccolor) + hex$(curr->ctype)
  213.       code$ = code$ + hex$(curr->set) + hex$(curr->rarity)
  214.       if len(code$) = 5 then code$ = "0"+code$
  215.       write #1,code$,curr->cname
  216.       locate 2,22
  217.       print loop
  218.       curr = curr->nextc
  219.     next
  220.     close 1
  221.     window close 2
  222.     curr = temp
  223.   end if
  224. return
  225.  
  226.  
  227. count:
  228.   window 2,,(0,0)-(360,150),0
  229.   FONT "topaz",8
  230.   cls
  231.  
  232.   temp = curr
  233.   curr = head->nextc
  234.   total = 0
  235.   unique = 0
  236.  
  237.   for xloop = 1 to 6
  238.     for yloop = 1 to 8
  239.       colcount(xloop,yloop) = 0  
  240.       unicount(xloop,yloop) = 0
  241.     next
  242.     setcount(xloop) = 0
  243.   next
  244.  
  245.   for loop = 1 to 13
  246.     freq(loop) = 0
  247.     unifreq(loop) = 0
  248.   next
  249.     
  250.   locate 2
  251.   print " Counting cards..."
  252.   for loop = 1 to numcards  
  253.     if curr->number <> 0 then
  254.       total = total + curr->number
  255.       ++unique
  256.       freq(curr->rarity) = freq(curr->rarity) + curr->number
  257.       unifreq(curr->rarity) = unifreq(curr->rarity) + 1
  258.       colcount(curr->set,curr->ccolor) = colcount(curr->set,curr->ccolor) + curr->number
  259.       unicount(curr->set,curr->ccolor) = colcount(curr->set,curr->ccolor) + 1
  260.       setcount(curr->set) = setcount(curr->set) + curr->number
  261.       unisetct(curr->set) = unisetct(curr->set) + 1
  262.     end if
  263.     locate 2,19
  264.     print loop
  265.     curr = curr->nextc
  266.   next
  267.   open "O",1,file$
  268.   print
  269.   print "Total cards (excluding basic lands) :";total
  270.   print #1,"Total cards (excluding basic lands) :";total
  271.   print "Total unique cards                  :";unique
  272.   print #1,"Total unique cards                  :";unique
  273.   print #1,chr$(13)
  274.   for xloop = 1 to 6
  275.     if setcount(xloop) <> 0 then
  276.       for yloop = 1 to 8
  277.         if colcount(xloop,yloop) <> 0 then
  278.           print #1,"Total  ";set$(xloop);" ";clor$(yloop);" cards";
  279.           print #1,space$(9-len(clor$(yloop)));":";colcount(xloop,yloop)
  280.           print #1,"Unique ";set$(xloop);" ";clor$(yloop);" cards";
  281.           print #1,space$(9-len(clor$(yloop)));":";unicount(xloop,yloop)
  282.         end if
  283.       next
  284.       print #1,"Total  ";set$(xloop);" cards: ";setcount(xloop)
  285.       print #1,"Unique ";set$(xloop);" cards: ";unisetct(xloop)
  286.       print #1,chr$(13)
  287.     end if
  288.   next
  289.   for loop = 2 to 13
  290.     if freq(loop) <> 0 then
  291.       print "Total "rarity$(loop);" cards";space$(16-len(rarity$(loop)));":";freq(loop)
  292.       print #1,"Total "rarity$(loop);" cards";space$(16-len(rarity$(loop)));":";freq(loop)
  293.       print #1,"Unique "rarity$(loop);" cards";space$(15-len(rarity$(loop)));":";unifreq(loop)
  294.     end if
  295.   next
  296.   gadget 50,ON,"OK",(113,125)-(145,140),BUTTON
  297.   gadget wait 50
  298.   gadget close 50
  299.   close 1
  300.   window close 2
  301.   curr = temp
  302. return
  303.  
  304.  
  305. genlist:
  306.   window 2,,(50,100)-(250,150),0
  307.   FONT "topaz",8
  308.   cls
  309.   locate 2
  310.  
  311.   temp = curr
  312.   curr = head->nextc
  313.  
  314.   open "O",1,file$
  315.     print "Saving list"
  316.   for loop = 1 to numcards
  317.     if curr->number <> 0 then
  318.       print #1,curr->number;chr$(9);
  319.       print #1,curr->cname;space$(35-len(curr->cname));
  320.       print #1,clor$(curr->ccolor);space$(10-len(clor$(curr->ccolor)));
  321.       print #1,set$(curr->set);space$(10-len(set$(curr->set)));
  322.       print #1,rarity$(curr->rarity)
  323.     end if
  324.     locate 2,15
  325.     print loop
  326.     curr = curr->nextc
  327.   next
  328.    close 1
  329.   window close 2
  330.   curr = temp  
  331. return
  332.  
  333.  
  334. search:
  335.   srch$=CSTR(gadget(2))
  336.   slen = len(srch$)
  337.   snf = 0
  338.   temp = curr
  339.   curr = curr->nextc
  340.   
  341.   while (left$(curr->cname,slen) <> srch$) and snf<>1
  342.     curr = curr->nextc
  343.     if curr = temp then 
  344.       snf = 1
  345.       beep
  346.     end if
  347.   wend
  348.   gosub display
  349. return  
  350.  
  351. quit:
  352.   gadget close 1
  353.   window close 1
  354.   
  355.   
  356. end
  357.  
  358.