Gury's Atari 8-bit Forever Portal - Site dedicated to Atari 8-bit home computers by Bostjan Gorisek (Gury)

Entry name:
SetColor
Category:
Programming utilities
Publisher/Developer:
Flop 9
Year:
1988
Media format:
Diskette
Programming language:
Turbo Basic XL
Entry name:
SetColor
Category:
Programming utilities
Publisher/Developer:
Flop 9
Year:
1988
Listing 1
32323 REM ****************************
32324 REM *  *
32325 REM * POKE 708-712 *
32326 REM * SETCOLOR 0 - 4 *
32327 REM *  *
32328 REM *  *
32329 REM ****************************
32330 REM
32331 REM
32332 DIM P$(8)
32333 GRAPHICS 0:Z=0:X=0
32334 POKE 752,1
32335 SETCOLOR 1,1,11
32336 SETCOLOR 2,1,4
32337 SETCOLOR 4,1,0
32338 FOR B=4 TO 19
32339 FOR A=4 TO 35
32340 POSITION A,B:? ""
32341 NEXT A
32342 NEXT B
32343 FOR B=7 TO 16
32344 FOR A=8 TO 31
32345 POSITION A,B:? " "
32346 NEXT A
32347 NEXT B
32348 POSITION 9,9:? "TENTO PROGRAM UMOZNUJE"
32349 POSITION 9,10:? " NALEZENI VHODNE"
32350 POSITION 9,11:? " KOMBINACE HODNOT"
32351 POSITION 9,12:? " POKE 708 az POKE 712"
32352 POSITION 9,13:? " nebo"
32353 POSITION 9,14:? " SETCOLOR 0 az 4"
32354 POSITION 4,21:? "GRAFICKY MOD .............*"
32355 ------------------------------
32356 GOSUB 32363
32357 KL=PEEK(764):IF KL=50 THEN G=0:GOSUB 32363:GOTO 32367
32358 IF KL=31 OR KL=30 THEN G=1:GOSUB 32363:GOTO 32367
32359 Z=Z+0.2:SOUND 0,Z,10,4:SOUND 1,Z*20,10,4:SOUND 2,Z*12+50,2,6
32360 SOUND 3,Z*3+6,8,6:SETCOLOR 1,0,Z:SETCOLOR 2,Z*5,2:SETCOLOR 4,Z*10+7,4
32361 GOTO 32357
32362 ------------------------------
32363 POKE 764,255:RETURN
32364 ------------------------------
32365 POKE 752,1:RETURN
32366 ------------------------------
32367 GRAPHICS G:GOSUB 32365:GOTO 32368
32368 FOR X=0 TO 3
32369 SOUND X,0,0,0
32370 NEXT X
32371 IF G=0 THEN 32373
32372 IF G<>0 THEN 32379
32373 POSITION 2,17:? "=SETCOLOR 1=POKE 709 "
32374 POSITION 2,18:? "=SETCOLOR 2=POKE 710 "
32375 POSITION 2,19:? "=SETCOLOR 4=POKE 712 "
32376 POSITION 2,20:? "=/="
32377 POSITION 2,21:? "= zapis SETCOLOR hodnot do programu"
32378 GOTO 32384
32379 ? "=SE.0=POKE 708/=SE.1=POKE 709"
32380 ? "=SE.2=POKE 710/=SE.3=POKE 711"
32381 ? "=SE.4=POKE 712/ ////////"
32382 POSITION 0,18:? #6;"**********"
32383 POSITION 0,17:? #6;"**********"
32384 GOSUB 32363:GOTO 32385
32385 KL=PEEK(764):IF G=0 AND KL=31 THEN 32406
32386 IF G=0 AND KL=30 THEN 32414
32387 IF G=0 AND KL=24 THEN 32422
32388 IF G=1 AND KL=50 THEN 32430
32389 IF G=1 AND KL=31 THEN 32438
32390 IF G=1 AND KL=30 THEN 32446
32391 IF G=1 AND KL=26 THEN 32454
32392 IF G=1 AND KL=24 THEN 32462
32393 IF G=0 AND KL=95 THEN 32407
32394 IF G=0 AND KL=94 THEN 32415
32395 IF G=0 AND KL=88 THEN 32423
32396 IF G=1 AND KL=114 THEN 32431
32397 IF G=1 AND KL=95 THEN 32439
32398 IF G=1 AND KL=94 THEN 32447
32399 IF G=1 AND KL=90 THEN 32455
32400 IF G=1 AND KL=88 THEN 32463
32401 IF KL=28 THEN 32367
32402 IF KL=23 THEN 32333
32403 IF KL=10 THEN 32470
32404 GOTO 32385
32405 ------------------------------
32406 GOSUB 32363:X1=X1+1:GOTO 32408
32407 GOSUB 32363:X1=X1-1:GOTO 32408
32408 IF X1>255 THEN X1=0
32409 IF X1<0 THEN X1=255
32410 POSITION 13,3:? " ":POSITION 4,3:? "POKE 709,";X1:POKE 709,X1
32411 POSITION 15,4:? " ":POSITION 4,4:? "SETCOLOR 1,";INT(X1/16);",";X1-16*INT(X1/16)
32412 GOTO 32384
32413 ------------------------------
32414 GOSUB 32363:X2=X2+1:GOTO 32416
32415 GOSUB 32363:X2=X2-1:GOTO 32416
32416 IF X2>255 THEN X2=0
32417 IF X2<0 THEN X2=255
32418 POSITION 13,6:? " ":POSITION 4,6:? "POKE 710,";X2:POKE 710,X2
32419 POSITION 15,7:? " ":POSITION 4,7:? "SETCOLOR 2,";INT(X2/16);",";X2-16*INT(X2/16)
32420 GOTO 32384
32421 ------------------------------
32422 GOSUB 32363:X4=X4+1:GOTO 32424
32423 GOSUB 32363:X4=X4-1:GOTO 32424
32424 IF X4>255 THEN X4=0
32425 IF X4<0 THEN X4=255
32426 POSITION 13,9:? " ":POSITION 4,9:? "POKE 712,";X4:POKE 712,X4
32427 POSITION 15,10:? " ":POSITION 4,10:? "SETCOLOR 4,";INT(X4/16);",";X4-16*INT(X4/16)
32428 GOTO 32384
32429 ------------------------------
32430 GOSUB 32363:X0=X0+1:GOTO 32432
32431 GOSUB 32363:X0=X0-1:GOTO 32432
32432 IF X0>255 THEN X0=0
32433 IF X0<0 THEN X0=255
32434 POSITION 11,1:? #6;" ":POSITION 2,1:? #6;"POKE 708,";X0:POKE 708,X0
32435 POSITION 13,2:? #6;" ":POSITION 2,2:? #6;"SETCOLOR 0,";INT(X0/16);",";X0-16*INT(X0/16)
32436 GOTO 32384
32437 ------------------------------
32438 GOSUB 32363:X1=X1+1:GOTO 32440
32439 GOSUB 32363:X1=X1-1:GOTO 32440
32440 IF X1>255 THEN X1=0
32441 IF X1<0 THEN X1=255
32442 POSITION 11,4:? #6;" ":POSITION 2,4:? #6;"poke 709,";X1:POKE 709,X1
32443 POSITION 13,5:? #6;" ":POSITION 2,5:? #6;"setcolor 1,";INT(X1/16);",";X1-16*INT(X1/16)
32444 GOTO 32384
32445 ------------------------------
32446 GOSUB 32363:X2=X2+1:GOTO 32448
32447 GOSUB 32363:X2=X2-1:GOTO 32448
32448 IF X2>255 THEN X2=0
32449 IF X2<0 THEN X2=255
32450 POSITION 11,7:? #6;" ":POSITION 2,7:? #6;" 710,";X2:POKE 710,X2
32451 POSITION 13,8:? #6;" ":POSITION 2,8:? #6;" 2,";INT(X2/16);",";X2-16*INT(X2/16)
32452 GOTO 32384
32453 ------------------------------
32454 GOSUB 32363:X3=X3+1:GOTO 32456
32455 GOSUB 32363:X3=X3-1:GOTO 32456
32456 IF X3>255 THEN X3=0
32457 IF X3<0 THEN X3=255
32458 POSITION 11,10:? #6;" ":POSITION 2,10:? #6;" 711,";X3:POKE 711,X3
32459 POSITION 13,11:? #6;" ":POSITION 2,11:? #6;" 3,";INT(X3/16);",";X3-16*INT(X3/16)
32460 GOTO 32384
32461 ------------------------------
32462 GOSUB 32363:X4=X4+1:GOTO 32464
32463 GOSUB 32363:X4=X4-1:GOTO 32464
32464 IF X4>255 THEN X4=0
32465 IF X4<0 THEN X4=255
32466 POSITION 11,13:? #6;" ":POSITION 2,13:? #6;"POKE 712,";X4:POKE 712,X4
32467 POSITION 13,14:? #6;" ":POSITION 2,14:? #6;"SETCOLOR 4,";INT(X4/16);",";X4-16*INT(X4/16)
32468 GOTO 32384
32469 ------------------------------
32470 REM ZAPIS DO PROGRAMU
32471 GRAPHICS 0:POKE 82,2:POKE 764,255:PO=0
32472 ?:? "OKE nebo ETCOLOR"
32473 KL=PEEK(764):IF KL=10 THEN P$="POKE":PO=1:GOTO 32476
32474 IF KL=62 THEN P$="SETCOLOR":GOTO 32476
32475 GOTO 32473
32476 POKE 764,255:?:? "Vybrane hodnoty instrukci ";P$:? "chci zapsat do programu od radku"
32477 INPUT "cislo ..... ",CIS
32478 S0=INT(X0/16):S1=INT(X1/16):S2=INT(X2/16):S3=INT(X3/16):S4=INT(X4/16)
32479 J0=X0-16*S0:J1=X1-16*S1:J2=X2-16*S2
32480 J3=X3-16*S3:J4=X4-16*S4
32481 PUT 125:POSITION 2,20:? "CONT"
32482 IF PO=1 THEN 32489
32483 POSITION 2,10:? CIS;"SE.0,";S0;",";J0
32484 POSITION 2,11:? CIS+1;"SE.1,";S1;",";J1
32485 POSITION 2,12:? CIS+2;"SE.2,";S2;",";J2
32486 POSITION 2,13:? CIS+3;"SE.3,";S3;",";J3
32487 POSITION 2,14:? CIS+4;"SE.4,";S4;",";J4
32488 GOTO 32494
32489 POSITION 2,10:? CIS+0;"POKE 708,";X0
32490 POSITION 2,11:? CIS+1;"POKE 709,";X1
32491 POSITION 2,12:? CIS+2;"POKE 710,";X2
32492 POSITION 2,13:? CIS+3;"POKE 711,";X0
32493 POSITION 2,14:? CIS+4;"POKE 712,";X4
32494 POSITION 2,0:POKE 842,13:STOP
32495 POKE 842,12
32496 PUT 125:?:?:? "HOTOVO":GOSUB 32505:PAUSE 25
32497 ? "Zapis je proveden nasledovne:"
32498 FOR A=0 TO 4
32499 LIST CIS+A:GOSUB 32505
32500 NEXT A
32501 ?:?:? "POKRACUJ V PSANI PROGRAMU !!!"
32502 ? "NOVE HODNOTY = ":CLR
32503 END
32504 ------------------------------
32505 SOUND 0,150,10,4:PAUSE 5:SOUND 0,0,0,0:RETURN
32506 ------------------------------
References
http://flop.atariportal.cz/dir1_27.htm
Listing downloads
This is non-commercial site, its content is based on Atari 8-bit home computer contents and references.
If you feel your rights are violated by showing/using any part of contents of your product represented on this page, please contact me immediatelly so I can remove it!
Atari 8-bit Source code
