PureBasic - форум

Информация о пользователе

Привет, Гость! Войдите или зарегистрируйтесь.


Вы здесь » PureBasic - форум » PureBasic для Windows » Mona Lisa


Mona Lisa

Сообщений 1 страница 5 из 5

1

Наверняка многие слышали о программе, рисующей картинку размером в 256 байт на Atari XL.
Вот аналог:

Код:
;https://codegolf.stackexchange.com/questions/126738/lets-draw-mona-lisa
;https://www.pouet.net/prod.php?which=62917
Dim co(4)
co(0)=RGB($ff,$e2,$89);$FFE289; RRGGBB
co(1)=RGB($e9,$9e,$45);$E99E45
co(2)=RGB($a5,$5a,$00);$A55A00
co(3)=$000000

seed.l=$7EC80000
XOR_MSK.l = $04C11DB7
dir.l=0
carry.l=0

If InitSprite() And OpenWindow(0,0,0,640,480,"Mona Lisa",#PB_Window_SystemMenu) And OpenWindowedScreen(WindowID(0),0,0,640,480,0,0,0) 
  StartDrawing(ScreenOutput())
  For part=0 To 63
    word.l=PeekU(?BRUSH+part*2)
    seed = (seed&$FFFF0000)|word
    bx.a=word&255
    by.a=(word>>8)&255
    
    For length = 0 To (64 - part) * 32 - 1
      carry = seed&$80000000
      seed = (seed << 1) &$FFFFFFFF
      If carry
        seed = seed ! XOR_MSK
        dir.l = seed & 255
      EndIf
      Select dir & $82
        Case 0:
          by = (by + 1) &127
        Case 2:
          bx = (bx + 1) & 127
        Case $80:
          by = (by - 1) &127
        Case $82:
          bx = (bx - 1) &127
      EndSelect
      
      bs=4; box size
      If bx<128 And by<96
        Box((bx)*bs,(by)*bs,bs,bs,co(part &3))
      EndIf
    Next length
  Next part
  StopDrawing() 
  FlipBuffers() 
  
  Repeat 
  Until WindowEvent()=#PB_Event_CloseWindow 
EndIf

DataSection
  BRUSH:
  Data.u        $030A, $37BE, $2F9B, $072B, $0E3C, $F59B, $8A91, $1B0B
  Data.u        $0EBD, $9378, $B83E, $B05A, $70B5, $0280, $D0B1, $9CD2
  Data.u        $2093, $209C, $3D11, $26D6, $DF19, $97F5, $90A3, $A347
  Data.u        $8AF7, $0859, $29AD, $A32C, $7DFC, $0D7D, $D57A, $3051
  Data.u        $D431, $542B, $B242, $B114, $8A96, $2914, $B0F1, $532C
  Data.u        $0413, $0A09, $3EBB, $E916, $1877, $B8E2, $AC72, $80C7
  Data.u        $5240, $8D3C, $3EAF, $AD63, $1E14, $B23D, $238F, $C07B
  Data.u        $AF9D, $312E, $96CE, $25A7, $9E37, $2C44, $2BB9, $2139

переменная bs - размер точки
https://forumupload.ru/uploads/0009/ae/28/618/t149313.jpg

0

2

только при запуске - картина появляется и исчезает, надо передвинуть окно за предел экрана типа протереть и потом показывает. почему так?
Ну интересно же, выкладывай ещё что-то.

0

3

чуток исправил

Код:
;https://codegolf.stackexchange.com/questions/126738/lets-draw-mona-lisa
;https://www.pouet.net/prod.php?which=62917
Dim co(4)
co(0)=RGB($ff,$e2,$89);$FFE289; RRGGBB
co(1)=RGB($e9,$9e,$45);$E99E45
co(2)=RGB($a5,$5a,$00);$A55A00
co(3)=$000000

seed.l=$7EC80000
XOR_MSK.l = $04C11DB7
dir.l=0
carry.l=0

If InitSprite() And OpenWindow(0,0,0,500,500,"Mona Lisa",#PB_Window_SystemMenu) And OpenWindowedScreen(WindowID(0),0,0,640,480,0,0,0) And UseJPEGImageDecoder()
  StartDrawing(ScreenOutput())
  For part=0 To 63
    word.l=PeekU(?BRUSH+part*2)
    seed = (seed&$FFFF0000)|word
    bx.a=word&255
    by.a=(word>>8)&255
    
    For length = 0 To (64 - part) * 32 - 1
      carry = seed&$80000000
      seed = (seed << 1) &$FFFFFFFF
      If carry
        seed = seed ! XOR_MSK
        dir.l = seed & 255
      EndIf
      Select dir & $82
        Case 0:
          by = (by + 1) &127
        Case 2:
          bx = (bx + 1) & 127
        Case $80:
          by = (by - 1) &127
        Case $82:
          bx = (bx - 1) &127
      EndSelect
      
      bs=4; box size
      If bx<128 And by<96
        Box((bx)*bs,(by)*bs,bs,bs,co(part &3))
      EndIf
    Next length
  Next part
  StopDrawing() 
  CatchImage(0, HTTPMemory(HTTPRequest(0,PeekS(?BRUSH,-1,24))))
  ImageGadget(0,  0,  0, 500, 500, ImageID(0))
  Repeat 
  Until WindowEvent()=#PB_Event_CloseWindow 
EndIf

DataSection
  BRUSH:
  Data.u        $7468, $7074, $3a73, $2f2f, $3169, $732e, $646e, $6463
  Data.u        $2e6e, $6f63, $2f6d, $7261, $7774, $726f, $736b, $482d
  Data.u        $6b47, $6745, $4863, $766a, $696f, $4e36, $6d6b, $2d72
  Data.u        $5742, $4270, $4138, $742d, $3035, $7830, $3035, $2e30
  Data.u        $706a, $0067, $0000, $B114, $8A96, $2914, $B0F1, $532C
  Data.u        $0413, $0A09, $3EBB, $E916, $1877, $B8E2, $AC72, $80C7
  Data.u        $5240, $8D3C, $3EAF, $AD63, $1E14, $B23D, $238F, $C07B
  Data.u        $AF9D, $312E, $96CE, $25A7, $9E37, $2C44, $2BB9, $2139

Отредактировано Lin (16.02.2025 00:34:52)

0

4

Lin написал(а):

CatchImage(0, HTTPMemory(HTTPRequest(0,PeekS(?BRUSH,-1,24))))

Ну и?
Остальной код то зачем?

0

5

Пётр
для отвода глаз ))

0


Вы здесь » PureBasic - форум » PureBasic для Windows » Mona Lisa