Świąteczne wyzwanie dla programistów

[Phonex]

Był dzień wolny, to posiedziałem jeszcze i udało się! Skróciłem do "poniżej 50" - 49 bajtów.
Ale po kolei.
Najpierw ten 60 bajtów (63 z czyszczeniem ekranu) - wyświetla 6 pełnych 32-znakowych linii, z zapisanego bitowo wzorca. I potem jeszcze 2 razy to powtarza. A ponieważ wyświetla 3 razy po tylko 6 linii, więc na koniec jeszcze raz pierwsza linia (bo jest identyczna z ostatnią).

Kod: [Zaznacz]

org 32768

call $1642 ;kanał 2
ld e,3 ;3 razy
loop0 ld b,24 ;6 linii (4 bajty na linie)
call show
dec e
jr nz,loop0
ld b,4 ;jeszcze raz pierwsza linia

show ld hl,dane
loop1 ld c,8 ;8 bitów
ld d,(hl)
inc hl
loop2 sla d
sbc a,a
and 10 ;"*" minus spacja
add a,32 ;spacja
rst 16
dec c
jr nz,loop2
djnz loop1
ret
;
dane defb 16,65,0,0,40,162,128,0,69,20,64,0
defb 130,8,32,0,69,20,64,0,40,162,128,0

Ale męczyło mnie, że we wzorcu są trzy takie same romby, więc w końcu udało mi się skrócić dane o 2/3 do pojedynczego rombu. Po każdym rombie wyświetla CHR$ 8 czyli jeden znak w lewo, dzięki czemu można wyświetlać romb w całości. I taki zestaw 3 rombów powtarza 3 razy. Przez błąd w ROM nie działa "o linię w górę" CHR$ 11, więc trzeba to zrobić przez zmienną systemową (23689). Dzięki temu można wyświetlać romb w całości 7x7, bez powtarzania pierwszej linii na zakończenie. Więc też krócej.
Manipulując położeniem danych/programu można skrócić sprawdzenie końca danych. No i udało się skrócić poniżej 50

Kod: [Zaznacz]

org 32727
;dobrac ORG, zeby DANE = $8001

call $1642 ;kanał 2

ld e,3 ;3 w pionie
show ld hl,DANE+6
loop0 ld b,3 ;3 w poziomie
loop1 ld c,7 ;7 znaków

ld d,(hl)
loop2 sla d
sbc a,a
and 10 ;"*" minus spacja
add a,32 ;spacja
rst $10
dec c
jr nz,loop2

ld a,8 ;o 1 w lewo
rst $10
djnz loop1
ld a,13 ;nowa linia
rst $10
dec l
jr nz,loop0
inc (iy+79) ;o 1 w góre
dec e
jr nz,show
ret
;
DANE defb 16,40,69
defb 130,69,40,16


W BASICu też napisałem. Próba przeniesienia rozwiązania asemblerowego to porażka, nie ma operacji na bitach więc wyszło ponad 200 bajtów. Zacząłem od nowa, ale w żaden sposób nie udało się 100b. Wymęczyłem 127 bajtów. Wszystko jest na maxa poskracane, nawet wpisane są kody OVER w linii. Co ciekawe wyszło krócej stosując TAB i manipulując OVER, niż AT.
Może by się udało w 100b, gdyby nie ten błąd w ROM, że nie działa CHR$ 10 i 11 (w dół i w górę)...

[ZorrO]

Ja jeszcze trochę nad swoim posiedziałem i zauważyłem że jeden z trików jakie użyłem do skracania w jednym miejscu skraca widzialną linię Basica a także jej zajętość w pamięci, a w innym miejscu ten sam trik skraca linie ale zwiększa jej zajętość. Dziwne. Program już i tak wysłany ale tak sie bawię. I po poprawce skróciłem o kolejne 6 bajtów. Da sie też przesunąć cały wzór na środek ekranu, ale to wydłuża o 7 bajtów, można też usunąć Ready wydłużając o 4 bajty.

Mam jeszcze jeden zupełnie inny pomysł jak przenieść całą mapkę gwiazdek do programu bez używania tylu strzałek i gwiazdek. Ale nie wiem za ile dni mnie złapie natchnienie aby przetestować czy będzie krótsze czy nie. Bo dziś i jutro zajmuję sie trawieniem, są Święta.

[Tygrys]

Finalnie nie wysłałem moich prób na konkurs. Mialem dwa podejścia.


1. Potraktowałem '*' jako boing balls Zdefiniowałem 3 '*' i tak jak w Pongu, odbijałem je od ścianek niewidocznej studni.
Finalnie wyszło 245 bajtów w BASIC

Kod: [Zaznacz]

10 LET o=VAL "1": LET t=VAL "3": LET s=VAL "17": DIM x(t): DIM y(t): DIM z(t): DIM c(t)
20 FOR i=o TO t: READ x(i): LET z(i)=o: LET c(i)=o: NEXT i
30 FOR i=o TO t: PRINT AT y(i),x(i);"*": LET x(i)=x(i)+z(i): LET y(i)=y(i)+c(i)
40 IF x(i)<o OR x(i)>s THEN LET z(i)=-z(i)
50 IF y(i)<o OR y(i)>s THEN LET c(i)=-c(i)
60 NEXT i: GO TO VAL "30"
70 DATA VAL "3",VAL "9",VAL "15"

oraz implementacja w asm (wynik: 62 bajty)

Kod: [Zaznacz]

    org 32768

_start:
    ld hl, _data
    ld  b,3
_b:
    push hl
    ld  a,22 ; AY
    rst 16

    inc hl ; to Y
    ld  a,(hl)
    rst 16
    inc hl
    inc hl ; to X

    ld  a,(hl)
    rst 16

    ld  a,'*' ; print '*'
    rst 16
    pop hl

    call    _calc ; Y
    call    _calc ; X

    djnz    _b
    jr  _start

_calc:
    ld  a,(hl) ; wsp_delta
    inc hl
    add a,(hl) ; wsp
    ld  (hl),a
    dec hl ; do wsp_delta
    cp  1
    jr  c,_reverse

    cp  18
    jr c,_ret

_reverse:
    ld  a,(hl)
    neg
    ld  (hl),a
_ret:
    inc hl
    inc hl
    ret

_data:
    ; delta y, y, delta x, x
    db  1, 0, 1, 3
    db  1, 0, 1, 9
    db  1, 0, 1, 15


2. Tym razem mniej kombinowania, dodanie przesunięcia dla każego nowego '*'.
BASIC wyszedl 192 bajty.

Kod: [Zaznacz]

10 LET x1=VAL "3": LET x2=VAL "15": LET y1=VAL "0": LET y2=y1: LET d=VAL "19"
20 PRINT AT y1,x1;"*": PRINT AT y2,x2;"*"
25 LET x1=x1+VAL "6": LET x2=x2-VAL "6"
30 IF x1>=d THEN LET x1=x1-d: LET y1=y1+1
32 IF x2<VAL "0" THEN LET x2=d+x2: LET y2=y2+1
40 IF y2<d THEN GO TO VAL "20"

zaś w asm odpowiednio 53 bajty

Kod: [Zaznacz]

    org 32768
start:
    ld  hl,768
    ld  de,3840
    ld  bc,4864

_mainloop:
    call    _print

    ex  de,hl
    call    _print
    ex  de,hl

    ld a,d
    sub c
    ld  d,a

    ld a,h
    add a,c
    ld  h,a

    cp b
    jr c,_skip1
    sub b
    ld  h,a
    inc l
_skip1:

    bit 7,d
    jr z,_skip2
    ld  a,d
    add a,b
    ld  d,a
    inc e
_skip2:

    ld a,e
    cp b
    jr nz,_mainloop
    ret

_print:
    ld  a,22 ; AY
    rst 16
    ld  a,l
    rst 16
    ld  a,h
    rst 16
    ld  a,'*'
    rst 16
    ret


[zoon]

Potraktowałem temat jeszcze inaczej niż przedpiścy. Zauważyłem, że taką ukośną kratkę można uzyskać gdy gwiazdka pojawia się wtedy, gdy reszta z dzielenia przez 6 wynosi 0 dla x+y lub x-y. Wystarczy wówczas przesunąć np. y o 3 aby zamiast wzoru X otrzymać romby.

Kod: [Zaznacz]

10 CLS : FOR y=3 TO 21: FOR x=0 TO 18: LET s$=" "
20 LET a=(x-y)/6: LET b=(x+y)/6: IF (a=INT a) OR (b=INT b) THEN LET s$="*"
30 PRINT s$;: NEXT x: PRINT : NEXT yNie używałem sztuczek z VAL ani NOT PI aby nie zaciemniać kodu, w efekcie uzyskałem 163 bajty kodu ASCII i 159 bajtów TAP.

[ZorrO]

Amstradowa wersja ciut skrócona tego pomysłu zajmuje w pamięci 127 bajtów.
10 CLS:FOR y=3TO 21:FOR x=12TO 30:a=(x-y)/6:b=(x+y)/6:IF a=INT(a)OR b=INT(b)THEN LOCATE x,y:?"*
30 NEXT:NEXT

[Tygrys]

A to wersja napisana przez Marco Varesio:

Kod: [Zaznacz]

3 LET x=RND*18
4 PRINT AT x,(RND>RND)*18-ABS (x-3-6*INT (RND*3));"*"
5 GO TO PI


[Phonex]

I pozamiatane!
Piękna konstrukcja: (RND>RND), i za sto lat bym na to nie wpadł. W tym celu zwykle pisałem INT (RND+.5), ani w połowie tak ładne, ani tak krótkie...

[ZorrO]

A cóż to RND>RND tak właściwie robi bo nie mam pojęcia jak to na Amstradowy dialekt przetłumaczyć.

[Phonex]

RND to liczba losowa z przedziału 0-1.
"PRINT x>y" daje wynik 1 jeśli x jest większy niż y, w przeciwnym razie daje 0.

RND>RND na pierwszy rzut oka jest nonsensem, na drugi rzut oka jest wcale nie najkrótszym zapisem liczby 0, dopiero po chwili dociera, że obie wartości RND są różne!

Więc w tym przypadku RND>RND to sposób na generowanie liczb 0 i 1, można to zastąpić - jak wyżej pisałem - INT(RND+.5)

[smok.wawelski]

Gdyby ktoś chciał zgłębić różne sztuczki Sinclair Basica, to polecam ten cykl artykułów twórcy Basicusa: http://blog.jafma.net/2020/02/24/efficient-basic-coding-for-the-zx-spectrum/. Niektóre z technik są zadziwiające.

[Gryzor]

A to wersja napisana przez Marco Varesio:

Myslalem, ze program musi miec koniec 

[ZorrO]

Jeśli dobrze liczę to o 19ej Polskiego czasu będzie transmisja na żywo z wynikami:
https://www.youtube.com/watch?v=RGv2u6epVTY

I widzę na kanale że podobne konkursy od kilku lat odbywają sie 2 razy w roku, także na ASCII-Arty.

[Tygrys]

A oto 23 bajtowy wyczyn Dr.DEEP (to on napisał szereg gier na ZX81 z 1KB RAM)

[damik]

Wow, szacun dla niego... ciekawe ile bajtów dzieliło go od II-miejsca?
 

[ZorrO]

Nigdy wcześniej nie widziałem tak dużo Magicznych Bejzików. Z buzią wciąż otwartą, kłaniam się każdemu programiście lepszemu ode mnie.
Mam 2ie miejsce w CPC Basic i czuję się bardzo pokornie.
Tylko dwa Bejziki krótsze niż mój zrozumiałem na tyle dobrze, że zdołałem je przetłumaczyć na CPC.
Reszta jest dla mnie jak nieznana Galaktyka.