spindle.queued.net Git - xodist/blob - inst.fth

   1 \ DebXO installer script
   2
   3 : disk-size  ( devspec$ -- #MB )
   4    open-dev ?dup 0<> if                         ( ih )
   5       dup " #blocks" rot $call-method           ( ih #blocks )
   6       ?dup 0<> if
   7          \ we're assuming a block size of 512 bytes
   8          d# 512 um*                             ( ih #bytes )
   9          d# 1,000,000 um/mod                    ( ih rem #MB )
  10          rot close-dev swap drop                ( #MB )
  11       else
  12 \ TODO
  13          drop
  14          0
  15 \      dup " block-size" rot $call-method        ( ih  size x )
  16 \      rot close-dev drop                        ( size.lo )
  17 \      d# 20 >>                                  ( #MB )
  18       then
  19    else
  20       0                                         ( #MB )
  21    then
  22 ;
  23
  24 : target-big-enough?  ( devspec$ -- flag )
  25    disk-size                                    ( #MB )
  26    \ we only support devices >= 1GB
  27    d# 1000 u< if
  28       " Installation target too small, must be at least 1GB.  Aborting..."
  29       dialog-alert
  30       false                                     ( flag )
  31    else
  32       true                                      ( flag )
  33    then
  34 ;
  35
  36 d# 128 buffer: verifystr
  37
  38 : user-verified?  ( tgt$ -- flag )
  39    \ ensure the user *actually* wanted to reformat the device..
  40    " WARNING: this will overwrite all data on " ( tgt$ str$ )
  41    verifystr pack $cat
  42    " .  Are you sure that you want to do this?" ( str2$ )
  43    verifystr $cat
  44    verifystr count                              ( finalstr$ )
  45    dialog-no                                    ( flag )
  46    dup invert if
  47       " Installation cancelled."
  48       dialog-alert
  49    then                                         ( flag )
  50 ;
  51
  52 : verify-target  ( tgt$ devspec$ -- )
  53    \ XXX: For some reason refresh isn't called after a dialog-alert
  54    \ (or menu item callback).  This means the menu display is incorrect
  55    \ until go-vertical is called.  Calling refresh manually here doesn't
  56    \ work... so for now, kill the menu and restart it later.
  57    menu-done                                    ( tgt$ devspec$ )
  58
  59    target-big-enough? -rot                      ( flag tgt$ )
  60    user-verified? and if
  61       true
  62    else
  63       \ installation cancelled/failed, redisplay menu
  64       (menu)
  65       false
  66    then
  67 ;
  68
  69 : choose-nand-item
  70    " the internal NAND storage" " /nandflash" verify-target if
  71       " installing!" dialog-alert
  72    then
  73    ." Nand" cr
  74 ;
  75
  76 : choose-emmc-item
  77    " the internal MMC device" " int:0" verify-target if
  78       " installing!" dialog-alert
  79    then
  80    ." EMMC" cr
  81 ;
  82
  83 : choose-sd-item
  84    " this SD card" " ext:0" verify-target if
  85       " installing!" dialog-alert
  86    then
  87    ." SD" cr
  88 ;
  89
  90 : choose-usb-item
  91    menu-done
  92    ." USB" cr
  93 ;
  94
  95 : choose-usb-item-0
  96    menu-done
  97    ." USB #1" cr
  98 ;
  99 : choose-usb-item-1
 100    menu-done
 101    ." USB #2" cr
 102 ;
 103 : choose-usb-item-2
 104    menu-done
 105    ." USB #3" cr
 106 ;
 107 : choose-usb-item-3
 108    menu-done
 109    ." USB #4" cr
 110 ;
 111
 112 0 value nr-targets
 113
 114 : has-target?  ( devspec$ -- flag )
 115    open-dev                                     ( ih )
 116    ?dup 0<> if
 117       close-dev
 118       nr-targets 1+ to nr-targets
 119       true
 120    else
 121       false
 122    then
 123 ;
 124
 125 \ : disk-size  ( devspec$ -- #MB )
 126 \   open-dev ?dup 0<> if                         ( ih )
 127 \      dup " size" rot $call-method              ( ih size.lo size.hi )
 128 \      rot close-dev drop                        ( size.lo )
 129 \      d# 20 >>                                  ( #MB )
 130 \      \ fuck your signed 32bit division..    d# 100000 /                               ( #MB ).
 131 \   else
 132 \      0                                         ( #MB )
 133 \   then
 134 \ ;
 135
 136 : debxo-find-targets  ( -- help0$ 'func0 'icon0 ... helpk$ 'funck 'iconk )
 137    0 to nr-targets
 138
 139    \ check for the existence of nandflash (XO-1)
 140    " /nandflash" has-target? if
 141       " Internal NAND"
 142       ['] choose-nand-item spi.icon
 143    else
 144       \ check for internal EMMC (XO-1.5, XO-1.75)
 145       " int:0" has-target? if
 146          64 alloc-mem >r
 147          " int:0" disk-size decimal             ( #MB )
 148          <# "  MB)" hold$ u#s " Internal MMC (" hold$ u#>
 149          r> pack count
 150          \ " Internal MMC"
 151          ['] choose-emmc-item spi.icon
 152       then
 153    then
 154
 155    " ext:0" has-target? if
 156        64 alloc-mem >r
 157        " ext:0" disk-size decimal               ( #MB )
 158        <# "  MB)" hold$ u#s " SD Card (" hold$ u#>
 159        r> pack count
 160 \      " SD Card"
 161       ['] choose-sd-item sdcard.icon
 162    then
 163
 164    \ check for up to 4 USB drives
 165    4 0  do
 166       i <# " /disk" hold$ u# " /usb/scsi@" hold$ u#>  string2 pack
 167       count has-target? if
 168          \ create description
 169          i 1+                                   ( i )
 170          64 alloc-mem >r                        ( i )
 171          <# u# " USB Disk #" hold$ u#>  r@ place
 172          string2 count disk-size decimal        ( #MB )
 173          <# "  MB)" hold$ u#s "  (" hold$ u#> r@ $cat
 174
 175          r> count                               ( desc$ )
 176          i <# u# " ['] choose-usb-item-" hold$ u#> evaluate usb.icon
 177       then
 178    loop
 179
 180 \ TODO: multiple usb disks?
 181 \ differentiate between installer disk & extra disk..
 182 ;
 183
 184
 185 : debxo-installer-menu  ( -- )
 186    \ populate stack w/ icon/target list
 187    debxo-find-targets
 188
 189    \ last entry on the list
 190    " Abort installation"
 191    ['] quit-item quit.icon
 192
 193    \ generate the menu
 194    d# 1 to rows
 195    nr-targets 1+ to cols
 196
 197    clear-menu
 198
 199    0 nr-targets  do
 200       0 i install-icon
 201    -1 +loop
 202 ;
 203
 204 : instmenu
 205    ['] debxo-installer-menu to root-menu
 206    (menu)
 207 ;