Keskustelu: Koodit: QB: Pelikortit

DECLARE SUB txt (tek$, mika.kx!, mika.ky!, vari!)
DECLARE SUB piirrakortti (x!, y!, puoli!, arvo!, maa!)
CLS
SCREEN 13
DIM SHARED tx AS INTEGER, ty AS INTEGER, tekstuuri AS INTEGER
DIM SHARED x(1 TO 52) AS SINGLE, y(1 TO 52) AS SINGLE, a(1 TO 52) AS SINGLE
DIM SHARED p(1 TO 52) AS SINGLE, m(1 TO 52) AS SINGLE
DIM SHARED kirjain(1 TO 8, 1 TO 8, 1 TO 255) AS INTEGER
GOSUB fontti.muistiin
GOSUB alustakortti                          'alustetaan pakka
LINE (0, 0)-(320, 200), 2, BF
FOR i = 1 TO 52
  piirrakortti x(i), y(i), p(i), a(i), m(i)
  WAIT &H3DA, 8
NEXT
END

fontti.muistiin:
FOR asciikoodi = 1 TO 255
 IF asciikoodi = 7 THEN asciikoodi = 8 ELSE 'estetään PIIPpaus
 COLOR 16: LOCATE 1, 1: PRINT CHR$(asciikoodi)
 FOR ky = 1 TO 8
  FOR kx = 1 TO 8
   vari = POINT(kx - 1, ky - 1)
   kirjain(kx, ky, asciikoodi) = vari
  NEXT kx
 NEXT ky
NEXT asciikoodi
RETURN


alustakortti:
tekstuuri = 2                               'korttien tekstuuri; luvut väliltä 1 - 60
i = 1
v = 0
FOR s = 1 TO 4                              'käydään silmukoilla
 FOR i = i TO i + 12                        'kortin kaikki muuttujat
  x(i) = i * 3 + 70                         'x-koordinaatit
  y(i) = i * 2 + 40                         'y-koordinaatit
  a(i) = i - v                              'arvo
  p(i) = 1                                  'puoli
  m(i) = s                                  'maa (1:Hertta,2:Ruutu,3:pata,4:risti)
 NEXT
 v = v + 13
NEXT
RETURN

SUB piirrakortti (x!, y!, puoli!, arvo!, maa!)
   IF puoli! < 3 THEN                                'jos kortti on oikeinpäin
    IF puoli! = 1 THEN c = 15                        'valitaan kortille
    IF puoli! = 2 THEN c = 0                         'väri, ja
    LINE (x! - 10, y! - 10)-(x! + 10, y! + 15), c, BF'luodaan kortin sisusta
   ELSE                                              'muulloin
   IF puoli! = 3 THEN c = 1                          'tehdään
   IF puoli! = 4 THEN c = 255: tekstuuri = -tekstuuri'kortin
    FOR py = -10 TO 15                               'päälypuoli
     FOR px = -10 TO 10
      PSET (x! + px, y! + py), c
      c = c + tekstuuri
     NEXT px
    NEXT py
   IF puoli! = 4 THEN : tekstuuri = -tekstuuri
   END IF
   IF puoli! = 1 OR puoli! = 3 THEN c = 0
   IF puoli! = 2 OR puoli! = 4 THEN c = 15
   LINE (x! - 10, y! - 10)-(x! + 10, y! + 15), c, B  'kortin reunat

   IF arvo! = 1 THEN arv$ = "A"
   IF arvo! = 2 THEN arv$ = "2"
   IF arvo! = 3 THEN arv$ = "3"
   IF arvo! = 4 THEN arv$ = "4"
   IF arvo! = 5 THEN arv$ = "5"
   IF arvo! = 6 THEN arv$ = "6"
   IF arvo! = 7 THEN arv$ = "7"
   IF arvo! = 8 THEN arv$ = "8"
   IF arvo! = 9 THEN arv$ = "9"
   IF arvo! = 10 THEN arv$ = "10"
   IF arvo! = 11 THEN arv$ = "J"
   IF arvo! = 12 THEN arv$ = "Q"
   IF arvo! = 13 THEN arv$ = "K"
   x = x - 4
   IF puoli! = 1 THEN
    SELECT CASE maa!
     CASE 1: c = 40: txt "�", x, y - 5, 40           'merkit ja
     CASE 2: c = 40: txt "�", x, y - 5, 40           'merkkejen väri
     CASE 3: c = 16: txt "�", x, y - 5, 16
     CASE 4: c = 16: txt "�", x, y - 5, 16
    END SELECT
   ELSEIF puoli! = 2 THEN                            'ja negana...
    SELECT CASE maa!
     CASE 1: c = 120: txt "�", x, y - 5, 120
     CASE 2: c = 120: txt "�", x, y - 5, 120
     CASE 3: c = 15: txt "�", x, y - 5, 15
     CASE 4: c = 15: txt "�", x, y - 5, 15
    END SELECT
   END IF
   IF puoli! < 3 THEN
    IF arv$ = "10" THEN x = x - 4
    x = x - 8                                        'asetetaan kursori kohdalleen
    txt arv$, x, y + 5, c                            'ja kirjoitetaan kortin arvo
   END IF
END SUB

SUB txt (tek$, mika.kx, mika.ky, vari)
FOR kerrat = 1 TO LEN(tek$)                      'näitä ei kannata
 asciikoodi = ASC(MID$(tek$, kerrat, LEN(tek$))) 'kauheasti tutkia
 FOR ky = 1 TO 8                                 'koska koodi on
  FOR kx = 1 TO 8                                'aivan hirveää
   IF NOT kirjain(kx, ky, asciikoodi) = 0 THEN
    kirjain(kx, ky, asciikoodi) = vari
    PSET (kx + mika.kx, ky + mika.ky), kirjain(kx, ky, asciikoodi)
   ELSE
   END IF
  NEXT kx
 NEXT ky
 mika.kx = mika.kx + 8
NEXT kerrat
END SUB